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ABSTRACT 

This  report  contains  the  write-ups 
and  listings  of  some  of  the  mathematical 
computer  routines  used  on  the  IBM  709^ 
Computer  at  New  York  University. 
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A  COLLECTION  OF  MATHEMATICAL  COMPUTER  ROUTINES 
Miriam  S.  Shapiro  and  Max  Goldstein 

Introduction. 


The  routines  presented  here  are  part  of  the 
basic  library  of  subroutines  available  to  users  of  the 
IBM  7094  Computer  at  New  York  University,  Courant 
Institute  of  Mathematical  Sciences.   Included  in  this 
report  are  the  mathematical  routines  for  computing 
Bessel  functions,  gamma  functions,  solutions  of  systems 
of  linear  equations,  eigenvalues  and  eigenvectors,  roots 
of  polynomials,  elliptic  Integrals,  solutions  of  systems 
of  ordinary  differential  equations,  matrix  inverses, 
minimization  routines,  and  several  special  purpose  and 
non-numeric  routines.   The  routines  which  have  not  been 
Included  are  those  which  are  a  part  of  any  scientific 
programming  system,  e.g.  sin,  cos,  and  those  which  are 
specifically  related  to  the  709^,  e.g.  input/output 
routines . 

The  most  frequently  used  routines  of  this  group 
originated  here  while  others  have  been  translated  from 
algorithms  written  in  ALGOL  60  which  appeared  in  the 
Communications  of  the  ACM  and  in  Numerlsche  Mathematlk. 
In  addition  some  of  the  routines  have  been  adapted  from 
the  subroutine  library  of  Los  Alamos  Scientific  Laboratory 
where  one  of  us  (M.G.)  was  intimately  Involved  in  their 
development . 
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The  routines  are  coded  either  in  FORTRAN  II  '[IBM 
7090/94  Programming  Systems:   FORTRAN  II  Prograimnlnp; . 
Form  028-6054)  or  in  FAP  (IBM  7090/94  Programming  Systems: 
FORTRAN  II  Assembly  Program  (FAP),  Form  C28-6255) .   In 
some  cases  we  have  included  both  FORTRAN  and  FAP  versions 
of  the  same  routine.   The  FAP  version  is  to  be  preferred 
for  general  use,  of  course,  since  without  question  it  is 
more  efficient.   For  experimenting  with  a  routine,  how- 
ever, the  FORTRAN  version  is  preferred.   The  FORTRAN 
versions  of  the  routines  generally  were  written  in  answer 
to  requests  from  people  who  were  changing  from  a  machine 
which  would  accept  PAP  to  one  which  would  not  (a  situation 
in  which  we  now  find  ourselves.'). 

The  routines  which  have  been  adapted  from  ALGOL  60 
were  written  for  experimental  purposes  and  in  general  are 
not  the  most  efficient  or  preferred  way  of  performing  a 
computation.   In  particular,  for  matrix  inversion  we 
prefer  the  FAP  version  of  LEQ  listed  under  "Solutions  of 
Systems  of  Linear  Equations"  and  none  of  those  listed 
under  the  heading  "Matrix  Inversion." 

For  each  routine  that  follows  there  is  a  write-up 
and  a  listing  of  the  symbolic  deck  for  the  routine.   As 
a  final  section  there  is  a  description  of  the  standard 
system  routines,  e.g.  square  root,  absolute  value,  which 
are  used  in  the  listed  routines. 


Bessel  Functions 

1.  BESS   Bessel  Functions  Package  -  FORTRAN  Coded 

2.  BES6   Single-Valued  Bessel  Functions  -  FORTRAN  Coded 

5.   BES4   Bessel  Functions  for  Complex  Argument  and 
Order  -  FORTRAN  Coded 

4.  BESSER  Bessel  Functions  for  Complex  Argument  and 

Order  -  FORTRAN  Coded 

5.  BESASY  Asymptotic  Bessel  Functions  for  Complex 

Argument  and  Order  -  FORTRAN  Coded 


Identification;   BESS  -  Bessel  Functions  Package 

Pour  709^  FORTRAN  Il-Coded  Subroutines 

Purpose:  Given  x,  v,  and  N,  to  compute  a  table  of  |n|+1  values 
for  the  Bessel  functions  of  real  order  and  argument, 

Jv+nf^)'  °^  ^-fn^^)^  °^  ^"%+n(^)'  ^^   ^\-,n^^'> ' 

for  x>-0,    0<v<l,    and  n  =  0,1,2, ...,N,    or 

n  =  0,-1,-2, . . .,-N. 
Restrictions: 

a)x>0;   0_<v<l 

b)  for   0  <  jc  <  lO"-^*^,    |n|  <  1 
for  10"-^°  1  ^   ^   10-5,  |n|  <  5 
for  10-3  <  X  <  1.0,    |N|  -^  (^.7-^I^in  x  "  ^^^ 
for  1.0  <x  <  50,      I  J,,  ^  (35^1/5  _  10) 
for  X  >  50,  no  restrictions  on  |n| . 

Method:   The  method  Involves  computing  the  Bessel  functions 

J  and  e~  I   for  all  orders  and  one  argument  by 

using  the  appropriate  recursion  relationships  and 

normalization  factors.   Y  and  e'^K  are  computed 

V  V  ^ 

by  summing  J  and  I  .   See  Goldstein,  M.  and 
Thaler,  R.,  "Recurrence  Techniques  for  the 
Calculation  of  Bessel  Functions,"  MTAC, 
Vol.  XIII,  No.  66,   April  1959- 

For  X  >   10.0  asymptotic  values  are  computed  using 
the  so-called  Phase  Amplitude  method.   See 
Goldstein,  M.  and  Thaler,  R.,  "Bessel  Functions 
for  Large  Arguments,"  MTAC,  Vol.  XII,  No.  6I, 
January  1958- 
Usage:    The  h   separate  subroutines  are  called  as  follows: 

CALL  BESSJ(X,FNU,N,VJ) 

CALL  BESSI(X,FNU,N,VI) 

CALL  BESSY (X,FNU,N,VJ,VY) 

CALL  BESSK(X,FNU,N,VI,VK) 
where 
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X  Is  the  argument  (X  >  0.0) 

FNU        is  the  order  v  (O  _<  v  <  1) 
|n|+1      is  the  number  of  values  to  be  computed 
VJ,VI,VY,VK  are  names  of  floating  point  vectors 

where  the  | N | +1  results  will  be  stored 
The  DIMENSION  of  these  vectors  must  be: 

a)  for  X  <  50,  DIMENSION  >  max(N+13,X+28) 

b)  for  X  >  50,  DIMENSIiZfN  >  In]  +2 
Results:  Let  VA  =  VJ,VY,VI  or  VK. 

Then,  upon  return  from  the  appropriate  subroutine: 
a)   For  N  >  0        or   b )   For  N  <  0 


VA(1)  =  F^(x)  VA(1)  =  F^(x) 

VA(2)  =  F^+i(x)  VA(2)  =  F^_i(x) 

VA(3)  =  P^+2^^)  VA(3)  =  Fv-2^^^ 


VA(N+1)  =  F^_^^(x)         VA(N+1)  =  F^_|N|(^) 
where  P  may  be  J,  Y,  e~^I,  e'^K. 
For  N  =  0,  F  and  F   -,  are  always  computed. 
To  compute  both  the  Y  and  J  functions,  a  single 
CALL  to  BESSY  is  sufficient  since  BESSY  must  call 
on  BESSJ  in  order  to  compute  the  Y  values. 
Similarly  a  single  CALL  to  BESSK  will  compute  both 
the  K  and  I  values . 
Accuracy: The  accuracy  is  variable,  depending  on  the  parameters 
and  the  function  desired.   For  function  values  less 
than  .1,  all  functions  seem  to  give  at  least  6 
decimal  place  accuracy  (not  necessarily  6  significant 
figures);  most  give  7  decimal  accuracy  and  many  give 
7  significant  figures.   For  larger  function  values, 
most  answers  seem  to  be  correct  to  6  or  7  significant 
figures.   For  x  >  50,  the  accuracy  of  J  and  Y  will 
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essentially  depend  on  the  accuracy  of  the  sin 

and  cos  routine. 
Note:     If  only  a  single  result  is  desired,  rather  than 

a  table  of  results,  the  reader  is  advised  to 

use  BES6. 
Requirements : 

a)  Non-System  Subroutines 
BESSI  uses  GAMMA 

BESS J  uses  GAMMA 

BESSK  uses  BESSI  and  GAMMA 

BESSY  uses  BESS J  and  GAMMA 

where  GAMMA  is  a  function  subprogram 

that  computes 

CD 

I   e"*^  u'^"-^  du  ,    for  Y  >  0 
Y 
and  is  used  in  the  following  manner: 

RESULT  =  GAMMAFrA,Y). 
The  subroutine  GAMMA  listed  in  this  report 
is  a  routine  which  fulfills  these  requirements. 

b)  System  Library  Functions  (closed  subroutines) 
BESSI  uses  EXP,  L0G -  SQRT 

BESS  J  uses  C^S,  L(2^G   SIN,  SQRT 
BESSK  uses  EXP,  L0G,  SIN 
BESSY  uses  C0S,  L0G,  SIN 

c)  System  Built-in  Functions  (open  subroutines) 
BESSI  uses  ABS,  XABS,  XMAXO,  XMINO 

BESSJ  uses  ABS,  XABS,  XMAXO,  XMINO 

BESSK  uses  XABS,  XMAXO,  XMINO 

BESSY  uses  XABS,  XMAXO,  XMINO 

d)  Storage 

BESSI   937;lo  "  ^^513  locations  plus  the 

required  subroutines  listed  in  a)  and  b). 

BESSJ   922-^Q  =  l652g  locations  plus  the 

required  subroutines  listed  in  a)  and  b). 
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BESSK   68l,Q  =  I25I0  locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
BESSY  735;lq  "  ^^^^8  locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
Authors:   Florence  F.  Ragusa  and  M.  Goldstein 
Date:      March  1964  (revised) 
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BESI  -  REAL  BESSEL  FI.NCTI0NS  -  F0RTR*N  II  C0OEO 


dESSI  NYU  MATH  CTILITY  BESSEL  I  SOER0UTINE   3/15/64     F.  RAGUSA  BESIOOIO 

SUBReUTINE  BESSUX.FNU.N.BI  )  BESI0020 

OIMENSIBN  ei(t)  8ESI0030 

EUUIVALENCE(FM.MF)  BESI0040 

C  BESI0050 

FM=ei(l)  BESI0060 

IY=1  BESI0070 

NN=XA8SF(N)  BESIOOeO 

CaNST=2.0/X  BESI0090 

C       WHEN  BI(I)  CBNTAINS  THE  INTEGER  I3IC70  ENTRY  WAS  FRBM  BESY.  BESIOIOO 

C  BE  S  I  0  1  1  0 

IF(MF- 131070)2. 1 .2  BESI0120 

»   IY=2  BESI0130 

C  BESI0140 

2      IF(X-50.)    42.17.17  BESIOISO 

42         X10=X»2£.  BESI0160 

K10=X10  BESI0170 

N10=NN*10  BESI0I80 

M=XMAX0F(K10.NI0)  BESI0190 

C  BESI0200 

IF(X-l.O)  3.3.41  BESI0210 

C  BESI0220 

3  KP=172.  69366/(3. 6eee7g5-LeGF(X) )  BESI0230 
M=XMINOF(M.KP)  BESI0240 

G0  T0  4  BESI0250 

C  BESI0260 

41      KP=3g.»X«». 3333333  BESI0270 

M=XMIN0F(K.KP)  BESI02e0 

4  M=M/2  BESI0290 
K=2«K*1  BESI0300 
K2=K+1  BESI0310 
K3=K+2  BESI0320 
BI  (K2)  =  l  .OE-37  BESI0330 
BI(K3)=0.0  BESI034C 

C  BESI03S0 

00  5  L=1.K  BESI0360 

I=K*1-L  BESI0370 

FLI=l  BESI0380 

5  BI  (  I  )=C0NST«(FLI*FNU)»BI(  !♦!  >*BI(I*2)  BESI0390 
C  F0H  ALPHA.  EQ.27.  PAGE  8  IF  X  LESS  THAN  10.0  BESI0400 
C                                                                                            BE  SI  04  10 

BESI0420 
BESI0430 
BESI0440 
BESI0450 
BES10460 
eESI0470 
BESI04eO 
BESI0490 
BESIOSOO 
BESI0510 
♦FIH))/(FLI»(FNU*FIK))«PSI  BESI0520 

BESIC530 
BESIOfAO 


IF(X-10 

.0)6, 

,17.17 

PSI=2.0» 

(FNU*! 

1.0) 

ALF=PSI« 

BI (2)«BI ( 1 ) 

K1=K-1 

00  7  1  = 

2.K1 

J=I*1 

FLI=I 

FIM=I-1 

rEMP=( (F 

NL+FL I  )»(2. 

PSI=TEVP 

ALF=PSI« 

BI ( J)»ALF 
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FBRTRAN  II  C0DEO 


ALF=C0NST» 

c 

11=1 

c 

e 

D0     9     1  =  1  1. 1 

9 

BI(  I  »=ei (  I 

c 

IF(N)10.  14 

10 

IF(  lY-2)  11 

iFNO«GAt<MAF(FNO+1.0.0)«ALF 

EOLiATIflN    24.     PAGE     8. 
)/ALF 


11  ei(  2)=CfaNST*FNL»8I  (  1  )*BI  (2) 
1F(NN- 1)14,14.12 

12  FRAC=FNU 

00  13  1=1. M 
FrtAC=FRAC- 1 .0 

13  BI{I+2)=C0KST«FR AC 'B 1(1*1) fB 1(1) 

14  G0  T0  (16.15).  lY 

15  FM=FK1 

N=MF 
X=FK2 
It  RtlLRN 

K0UNT=1 

GNU=FNU 
C0=.25 

CI  =.15625 

C2  =-.375 

C3  =. 1 171675 

C4  =-1.15625 

C5  =1.875 

C6  =.0952  1484375 

C7  =-2.38671675 

Ce  =14.2265625 

C9  =-19.68750 

C  10  =  8.09326 1 7  19E -2 

CI  l=-4. 100585937 

C12=5e. 224609375 

C13=-277. 87500 

C14=354.3750 

C15=. 0416666666 

C16=-.25 

C  17  =  . 125E-1 

cie=-.3S0 

C19=. 000558035718 
C20=-  .4241071428 
C21=3. 60267857 
C22=-5.e25 
C23=. 0030381944 
C24=-.4e6  1 1  I 
C25=10. 28645833 
C2e=-58.0 


BESI0550 
BESI0560 
8ESI0570 
6ESI0580 
BESI0590 
8ESI0600 
BES10610 
BeS10620 
BESI0630 
BESI0640 
BESI0650 
BESI0660 
BESI0670 

BEsioeeo 

BESI0690 
8ESI0700 
86510710 
BESI0720 
BES10730 
BESI074C 
BESI0750 
BESI0760 
BESI0770 
BESI078C 
BESI0790 
BESI0800 
BESI0810 
8ESI0820 
8ESI0830 
BESIOe40 
BESI0850 

BESioeeo 

BESI0870 

BESioeao 

BESI0890 
BE5I0900 
BESI0910 
BESI0920 
BESI0930 
BESI094C 
BESI0950 
BESI0960 
BESI0970 
BESI09e0 
BESI0990 
BESI 1000 
BESI 10  10 
BESI 10  20 
BESI 1030 
OESI 1040 
BESI 1050 
BESI 1060 
BESI 1C70 
BESI 1080 
BESI 1090 
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C27=7e.75 


iL  1  = 

GNU««2- 

.25 

A2 

=CC«AL1 

A4 

=  C 1 'AL  I 

A4  = 

( AA+C2  ) 

•AL  1 

A6  = 

C3«AL1 

A6  = 

(AttC4  ) 

•AL  1 

A6  = 

( Ae+C5  ) 

•AL  1 

Ae  = 

C6»AL1 

Ae  = 

( Ae+c? 

)  'ALl 

Ae  = 

(Ae+ce 

)»ALl 

AB  = 

( AetC9 

)»AL1 

AlC 

=C10«ALI 

AlC 

=( AlO+Cll )«AL1 

AlO 

=( A1C*CI£)»AL1 

AlC 

=( AlC+C 

13)»AL1 

AlC 

=  {  AIO  +  CIA  >»AL  1 

'1  =  3 

.141592 

6EJ5879 

TS  = 

1.0/X 

T2  = 

TS«»2 

6=-A10«T2tA8 
H=B«T2-Ae 
B=D«T2»AA 
P=B»T2-A2 
D0VT=R»T2+  1  .( 


=  C 15«AL  1 

= ( A4+C 16 )«AL1 

=  C17»AL  1 

=( Ae+c le ) "ALi 

=  ( Ae  +  .7=  )«AL1 

=  C19«AL  1 

=( A8+C20>«AL1 

=( A8*C21 )«AL1 

=( Ae*C22)*ALl 

0=C23«AL1 

C=:(  A1C  +  C2A  )«AL1 

C=( AIC*C2E)«AL1 

C=( A10*C2e )»AL1 

0=< A10+C27)«AL1 


e=-A10«T2»Ae 

e=o«T2-Ae 

B=H«T2*AA 
R=8«T2-A2 
DNU=e»T2 


'T«SORTF<  TS/<PI»2.  )  )»exPF(BM 
IVT»SGRIF((PI»TS)/2.)»EXFF<-) 


2  1.21  .22 


•X)«( 
'BNL  ) 


!•( 1 .>6NU) ) ) 


BESI  1  too 

BESI  1  1  to 
BESI 1120 

BESI  1130 

BESI  I  140 
BESI 1 150 
BESI 1160 
BESI 1170 

BESI  1 leo 

BESI 1 190 
BESI 1200 
BESI 1210 
BESI 1220 
BESI 1230 
BESI 124C 
BESI 1250 
BESI 1260 
BESI 1270 
BESI 1260 

BESI  1290 
BESI 1300 
BESI 1310 
BESI 1320 
BESI 1330 
BESI 134C 
BESI 1350 
BESI 1360 
BESI 1370 
BESI 1360 
BESI 1390 
BESI 1400 
BESI 14  10 
BESI 1420 
BESI 1430 
GESI 1440 
BESI 1450 
BESI 1460 
BESI 1470 
BESI 1460 
BESI 1490 
BESI 1500 
OESI 1510 
BESI 1520 
BESI 1530 
BESI 1540 
BESI 1550 
BESI 1560 
BESI 1570 
BESI 1580 
BESI 1590 

OESI  1600 
HESI 16  10 
HESI 1620 
HESI 1630 
OESI 164C 


eeSI  -  REAL  BESSEL  FUNCTI0NS  -  FBBTBAN  II  C0OED 

FSAVE=F1  BESII650 

FKSVE  =  FK1  BeSH660 

GNO=FNU+1.0  86511670 

K0LNT=2  BESIieaO 

G0  T0  18  BESI 1690 

F2  =  F1  BESIWOO 

FK2=FKl  BeSI1710 

F1=FSAVE  86511720 

FKl=FKSVE  BE5I1730 

IF(X-50.)  23.27,27  BESI1740 

IF( ABSFIF  l)-ABSF(F2)  )  24.24.25  BES11750 

ALF=BI{2)/F2  BESI1760 

G0  T0  26  8ESI1770 

ALF=BI{1)/F1  86511780 

BI(1)=F1  BES11790 

BI(2>=F2  BESI1800 

11=3  BESIiaiO 

G0  T0  e  8651 1820 

BI(1)=F1  86511830 

BI(2)=F2  BESI184C 

IF(N)   10.14.28  86511850 

IF(N-l)   14.14.29  B6SI1860 

N  1  =  NN* 1  B6S I  1870 

FLI=0.0  8ESI1880 

00  30    1=3. Nl  BESI1890 

FLI=FLI+1.0  BESI1900 

81(1  )=-(C0NST»(FNU+FLI  )»BI (I-l )-BI  (1-2)  )  865  I  1910 

G0  T0  14  86511920 

eNO  86511930 


16  - 


IF(MF-13107C 

IY=2 

C0NST=2.O/X 

iF(x-50.)  e.e 

X10=X+25. 

K10=X10 

N10=NN* 10 

M  =  XMAXOF(K  10.1 

REAL  BESSEL  FUNCTIBNS  -  F0RTRAN  II  C0OEO 


:SSJ  NYU  MATH  UTILITY  BESSEL  J  SLERBLITINE   3/15/64     F.  RAGUSA  BESJOOIO 

SUBR0UTINE  BESSJ( X.FNU.N.F)  BESJ0020 

OIMENSI0N  F(l)  BESJ0030 

EQLII  VALENCE<FM.MF  )  RESJ0040 

BESJ0C50 

NN=XABSF(N)  BESJ0C60 

•HEN  BESJ  HAS  BEEN  CALLED  BY  EESY  F(I)  WILL  C0NTAIN  THE  INTEGER  13BESJ0070 

FM=F< 1 )  BESJOOeO 

IV=1  BESJC090 

.2  8ESJOI00 

BESJOl 10 
BESJ0120 
BESJ0130 
BESJ0140 
BESJ0150 
8ESJ0160 
BESJ0170 
BESJOiaO 
BESJ0190 
IF(X-l.O)  3.3.41  BESJ0200 

KP=i72.6<)3ee/(  3.eeee795-L0GF<x))  be sj 0210 

M=Xy INOF(M,KP)  BESJ0220 

GB  T0  4  BESJ0230 

KP=39.»X««. 3333333  BESJ0240 

M  =  XMINOF(*(,KP)  BESJ0250 

M=M/2  BESJ0260 

K=2«M*I  BeSJ0270 

K2=K*1  BESJ02eO 

K3=K*2  BESJ0290 

F(K2)=l.0E-37  BESJ0300 

F(K3)=0.0  BESJ0310 

aESJ0320 

C05  L=1.K  8ESJ0330 

I=K*1-L  BESJ034C 

FLI=1  BESJ03S0 

F(I)=C0NST*(FLI+FNU)»F(I*1)-F(I*2)  BESJ0  360 

8ESJ0370 

FIND  ALPHA  EITHER  FH0M  EQLA.   12. PAGE  4  WHEN  X  IS  LESS  THAN  8.0  BESJ0380 

0R  FR0M  BESSEL  FLNCT.  F0R  LARGE  ARGUMENTS  WHEN  X  IS  = 0R  GREATER.  BESJ0390 

BESJ0400 

IF(X-10.>  7, e.e  BFSJ0410 

PHI=FNU*2.C  BESJ0420 

ALF=PHI«F(3)+F( 1 )  8ESJ0430 

M0=3  BESJ0440 

BESJ0450 

D0I5  1=2. M  8ESJ0460 

M0=M0«2  BESJ0470 

FM2=2»I  RESJ04e0 

FM1=I-1  eESJ0490 

FI=I  BESJ0500 

TEMP=(  (FNU*FM2)»(FNU+FM1  )>/(FI»(FNL+FM2-2.0)  ) 'PH I  BE S JOS  10 

PHI=TEMP  BESJ0520 

ALF=PHI»F(M0)+ALF  8ESJ0530 

BESJ054C 
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MEAL  BESSEL  FtNCTieNS 


F0RTRAN  II  CaOEO 


ALF  =  C0NST••FNO•GA^<^»AF(FNt♦l.O.O)•ALF 

I  1=1 

FIND  J(N)  EQLAT10N  7. PAGE  3.»»-EN  X  LESS  THAN  10.0 

0R  J(2).J(3) J(N)=F(2  )/ALPHA F(N)/ALPHA  WHERE 

ALPhA=F( 1 )/J( 1 )  AND  J ( 1 ) = A«C 0 S ( PH I )  FRBM  PATH  8. 

D017   1=1 1 .K 
F(  I  )=F (  I  )/ALF 

TEST  F0R  NEGATIVE  N   AND  fiECaVPUTE  FS  Er  RECURS  I 0^ 
IF (N  )   ie.22.22 
IF{  IY-2  )   19,22.  19 
F(2)=C0NST»FNL»F(I)-F(2) 
IF(NN-l)  22.22.20 
FRAC=FNU 
N1=NN*1 
00  21    L=3.N1 
FRAC=FRAC- 1 .C 
F(L)  =  C0NST»FRAC«F(L-1  )-F<L-2) 

IF  ENTRY  WAS  FRam  BESY  RETtRN  A  VALLE  F0H  Y(l)   IN 
PLACE  0F  N.IY  WILL  BE  EQUAL  Te  2  IN  THIS  CASE. 

G0  T0  (24.23  1. lY 
FM  =  Y  1 
N  =  MF 

X  =  Y2 
RETURN 

'TH  8.  WHEN  X   IS  GREATER  THAN  0R  =T0  10.0 

C0MPUTE  J(l)  FR0M  M.G0LOSTEIN  PAPER  BESSEL 
FUNCTIBNS  F0R  LARGE  ARGUMENTS. 

K0LNT= 1 

GNU=FNU 

CO  =.25 

CI  =. 15625 

C2  =-.375 

C3  =.  117167  = 

CA  =-1.15625 

C5  =1.875 

C6  =.09521464375 

C7  =-2.38671875 

Ca  =14.2265625 

C9  =-19.6e75C 

C10=e.093261719E-2 

CI  l=-4.  100585937 

C12=5e. 224609375 

C13=-277. 87500 

C14=354.3750 

C15=. 0416666666 

Cl6=-.25 

C  17  =  .  125E-1 

C18=:-.35C 


BESJOSSO 
BESJOS60 
BESJ0570 
BESJ0580 
BESJ0590 
BESJ0600 
BESJ0610 
RESJ0620 
BESJ0630 
BESJ0640 
8ESJ0650 
BESJ0660 
BESJ0670 
BESJ0680 
BESJ0690 
BESJ0700 
BESJ07  10 
BESJ0720 
BESJ0730 
BESJ0740 
BESJ0750 
BESJ0760 
BESJ0770 
BESJ07eO 
BESJ0790 
BESJOeOO 
BESJOaiO 
BESJ0820 
BESJ0e30 
BESJ084C 
BESJOfiSO 
BESJ0860 
BESJ0870 
BESJ088C 
BESJ0890 
BESJ0900 
BESJ0910 
BESJ0920 
BESJC930 
BESJ094C 
BESJ0950 
BESJ0960 
BESJ0970 
0ESJ0980 
BESJ099C 
BESJIOOO 
BESJIOIO 
BESJ1020 
HESJ1030 
BESJ 1040 
BESJ1050 
BESJ1C60 
BESJ1070 
BESJ1080 
BESJ1090 


18  - 


SeSJ  -  REAL  BESSet  FLNCTI0NS 


BESJl 100 
BESJlllO 
BESJl 120 
BESJl 130 
BESJ114C 
BESJ1150 
BESJlieO 
BESJ1170 
BESJ 1 leo 
BESJ1190 
BESJ1200 
BESJ1210 
BESJ1220 
8ESJ1230 
6ESJ1240 
BESJ1250 
BESJ1260 
BESJ1270 

Besji2eo 

BeSJ1290 
BESJ1300 
BESJ 13 10 
BESJ1320 
BESJ1330 
BESJ134C 
BESJ1350 
BESJ1360 
HESJ137C 
8ESJ13e0 
BESJ1390 
H  =  *10«Tit/>e  BESJ1400 

B  =  e»T2>Ae  BESJMIC 

B=B»T2+A4  BESJ1420 

Q=e«T2+A2  BESJ1430 

UMJ=e»T2+1.0  BESJ144C 

BESJ1450 
ANt=aNL/SGRTF ( .5»PI»X )  BeSJl460 

BESJ1470 
PAGE  20,  EGLATI0N  12  T0  GET  PHI   ZERK  BESJ14eO 

BESJ 1490 
A2=.5«AL1  BESJ1500 

A4=C15«AL1  BESJISIO 

A4=( A4*C 16 )»AL1  BESJ1520 

A6=C17»AL1  BESJ1530 

A6=( At+Cie )«AL1  BESJ1540 

A6= ( Ae».7; )«AL1  BESJ1550 

Ae=C19»ALl  BESJ1560 

Afi= ( A8»C20)«ALl  BeSJl570 

Aa=( Ae  +  C2  1  )«AL1  BESJ1580 

Ad=( A8+C22 )»AL1  BESJ1590 

A1C=C23«ALI  BESJ1600 

A1C  =  ( A10  +  C24  )  "AL 1  BESJ1610 

A  1C  =  ( A10  +  C25  )  "ALl  8ESJ1620 

A 10=( A lC*C2e ) "AL 1  0ESJ1630 

A 1C=( A IG+C27 ) "AL 1  HESJ164C 


C19 

=.000551 

6035718 

C20 

=-      .424 

1071428 

C21 

=3.60267857 

C22 

=-5.625 

C23 

=  .003031 

B1944 

C24 

=  -.46611  1 

C25 

=10.2e645f 33 

€26 

=-58.0 

C27 

=78.75 

AL  1 

=  GNU««2- 

-.25 

A2 

=  CC»AL  1 

A* 

=C 1»AL1 

A<>  = 

( A4+C2) 

•ALl 

A6  = 

C3»AL1 

A6  = 

( A6  +  C4  ) 

•AL  1 

A6  = 

( A6+C5  ) 

»AL  1 

Aa  = 

C6»AL I 

A0  = 

( Ae+C7 

)  'ALl 

Ae  = 

( Aa+ce 

)«AL1 

A8  = 

( Aa*C9 

)«AL1 

AlO 

=C10«AL 

1 

AlC 

=( AlO+C 

1 1)»AL1 

AlO 

=( AlC+C 

12)»ALI 

AlC 

=( AlO+C 

1 3)*AL  1 

AlO 

=( AlO+C 

14  )»AL1 

PI  = 

3. 141592654 

TS  = 

1.0/x 

T2  = 

TS«»2 

19 


BESJ  -  REAL  BESSEL  FLNCTI0NS  -  F8RTBAN  II  CBDEO 

C  B6SJI650 

B=*10»T2*A8  BESJieeO 

B=E»T2+A6  BESJI670 

B=B«T2*A4  BESJ1680 

a=B«T2+A2  BESJ1690 

TPI-I  =  e«T2*  1.0  BESJ1700 

PHI  =  TP»-I»X  -(GNC+.S  >«(PI/2.0)  BESJ1710 

CflP=CaSF(PHI )  BESJ1720 

SIP=SINF<PHI )  8ESJ1730 

C  BESJ1740 

Fl  =  ANlj«C0P  BESJI750 

Yl=ANU»SIP  BESJ1760 

C  BESJ1770 

IF(K0UM-l)   10,10.11  BESJ17eO 

C  BeSJ1790 

10  FSAVE=Fl  BESJiaOO 
YSAVE=Y1  BESJ18I0 
GNl.  =  FNU+1.0  BESJieZO 
K0LINT  =  2  BESJiaaO 
CIA     T0     9  BESJ184C 

C  BESJ1850 

11  F2=F1  BESJ1860 
Y2=Y1  BESJ1870 

Fl=FSAvF  BEsjieeo 

Y1=YSAVE  BESJie90 

C  BESJ1900 

IF{X-50.)   lie.  111. Ill  BESJ1910 

lie     1F( A05F(F 1 )-ABSFtF2) )   12.12.13  BESJ1920 

111     F( 1 )=F1  BESJ1930 

F(2)=F2  BESJ1940 

IF(N)   16,22,112  BESJ1950 

lli     IF{N-1)  22,22,113  BESJ1960 

li;     Nl=NNtl  BESJ1970 

FLI=0.0  HESJ19eO 

D0   lift    1-3, Nl  BESJ1S90 

FLI=FLI+1.0  BESJ2000 

lift       F(  I  )  =  C0NST» (FNU+FLI  )»F(  I-l  )-F(  1-2)  BESJ2010 

G0  T0  22  BESJ2020 

C  BeSJ2030 

12  ALF=F(2)/F2  BESJ204C 
G0  T0  14  BESJ2050 

C  BESJ2060 

13  ALF=F(1)/F1  BESJ2070 

14  F ( I )=r 1  BESJ2080 
F(2)=F2  BESJ2090 
11=3  BESJ2100 
G0  T0  le  BeSJ2110 
ENC  BESJ2120 


eeSK  -  REAL  BESSEL  FLNCTI0NS  -  F0RTR*N  II  CBOED 


:SK  NYL  MATh  LTILITY  HESSEL  K  SLeRBLTlNE    3/15/64     F.  RAGUS/ 
SUBHULTINE  BE S SK ( X ,FNU , N , B I . BK ) 
CIWENSI0N  HI ( 1 ) .BK( 1 ) 
fcCUI VALENCeC  FM.yP ) 

C0St-F(Z)  =  .5»(EXPF(Z)  +  (l.C/EXFF(Z))) 

XSAVE=X 

MF=:  131070 
ei  (  1  >  =FV 
13  CALL  BESSI (X.FNU.N.BI ) 
^'F  =  N 
OKI  1  )=FM 
BK(2)=X 
X=XSAVE 
CUNST=2.0/X 

NN=XABSF<N) 
N1=KN-1 

IF(X-IC.O)   14. 03. 43 
X10=X+25. 
K1C=X10 
N10=NN+  IC 
M=XMAXOF( K IC.NIO) 

IF(X-  1.0)   1,30,30 

KP= 17  2.69  3ee/(3.6eee795-LaGF (X) ) 

M  =  XMIN0F(y .KP  ) 


3CC 
31C 


CiaNS2  =  C0NST»«(2.O»FNU) 

PI=3. 14 15S2e535e7q 

ARG=P I«FNL 

GARG  =  GAr/yAF(FNU+1.0,0)»»2 

TeHK'  =  C0NS2»GAHG 

IF(FNL)  310,320,310 
DELTAl=-l.C/(2.0«FNL)»(ARG/SISF(ARG)-TeRV) 
0ELTA2=TERM»(FNL+2.C)/(l.C-FNL) 
G0  TH  330 

DELTAl=-(57.721E6e4QE-2+LeGFIX/2.C)) 
CELTA2=2.C 

f)K(  1  ) -DELTA  1»HI  (  1  ) 

12=  1 

ML  1 -M-  1 

Off     340         I  =  1  .yLl 

IPI  =  I  ♦  1 

12=12*2 
F  I2  =  2«  IPl 


BESKOOIO 
BESK0020 
BeSK0030 
HESKOOAC 
BESKC050 
BESKOOeO 
BESK0070 
BESKOOeO 
BESK0090 
BESKOIOO 
BESKOl 10 
BESK0120 
BESKO130 
BESK0140 
BESK0150 
HESK0160 
BESK0170 
BESK0180 
BESK0190 
BESK0200 
BESK02 10 
BESK0220 
BESK0230 
BESK0240 
BESK0250 
BESK0260 
BESK0270 
BESK0280 
8ESK0290 
BESK0300 
BESK0310 
HESK0320 
BESK0330 
BE5K034C 
BESK0350 
BESK0360 
BeSK0370 
BeSK0380 
BeSK0390 
BE5K0400 
BESK0410 
BESK0420 
BESK0430 
oe5K0440 
BESK0450 
BESK0460 
BESK0470 
8ESK0480 
BESK049C 
HESK0500 
BESKOSIO 
BESK0S20 
8ESK0530 
BESK0540 


-    21     - 


BESK  -  REAL  BESSEL  f=V;NCTI0NS  -  FBRTBON  II  C0OEO 

FI=IPl  BESKOSSO 

DEN0M  =  FI«(FNIJ+FI2-2.O)»(FI-FNU>  BESK  0560 

DELTA3  =  (FKU*FI2)» ( 2 . 0»FNt*F I  V ) • { F NU  +  F I M ) /DENeW  BESK05  70 

DELTA3=CELTA3«oeLTA2  BESKOSBO 

BK< 1 )=0ELTA2»BI ( I2)+BK( 1 1  BESK 0590 

3tC           DELTA2=0ELTA3  BESK0600 

C  BESK0610 

12=12*2  BESK0620 

BK(  I  )  =  DELTA2*BI ( I2)*BK<  1 )  BESK 06 30 

BK<  1)=BK(  I)«EXPF(2.0»X)  BESK0640 

G0  T0  15  BESK0650 

C  BESK0660 

30     H=.2  BESK0670 

1=34  BESKOeaO 

Y=0.0  BESK0690 

SUM=1.0  BESK0700 

J=2  BESK0710 

31     FACT  =  <».0  BESK0720 

Y=Y*H  BESK0730 

FY  =  EXPF(  X»(1.O-C0SHF(Y)))»C0S»-F(FNL«Y)  BESK  0740 

SUM=SUM+FACT«FY  BESK0750 

IF(J-l)     4C,41.41  BESK0760 

40  J=J*1  BESK0770 

FACT=2.C  BESK0780 

Y=Y+H  BESK0790 

FY=EXPF(X»( 1.O-C0SHF (Y)))«C0ShF(FNL«Y)  BESK 0800 

SLM=SUM+FACT»FY  BESK0810 

j=j+l  BESK0820 

G0     T0     31  BESK0830 

C  BESKOBAC 

41  Y=Y+H  BESK0850 
FY=exPF(X•(l.O-C0SHF(Y)))•C0S^F(F^t•Y)  BESK 0860 

SUM=StM+FY  BESK0870 

SUM=SLM«(F/3.0)  BESKOeaO 

BK{ 1 )=SUM  BESK0890 

15      BK( 2 )  =  (  (  1 .0/X  )-eK(  1  )«BI  (2)  )/ei(  1  )  BESKOQOO 

C  BESK0910 

43      IF   (N)  5C.39.36  BESK0920 

36  IF(N-l)     39.39.37  BESK0930 

37  00     38     1  =  1. Nl  BESK0940 
FLI=I  BE5K0950 

38  BK(I  +  2)=     C0NST»(FLI+FNU)      »8K  (  I  ♦  1  ) -fBK  (  I  )  BESK0960 

39  RETURN  8ESK0970 
C  BESK0980 

50  BKC 2 )=-C0N£T»FNU«BK(  1  )*8K(2)  BESK0990 

8((2)=C0NST«FNU»BI(l)-fBI(2)  BESK  1000 

IF(NN-l)     39,39.51  BESKIOIO 

51  FRaC=FNU  BESK1020 
C  BESK1030 

00     52         1=1. Nl  BESK104C 

FRAC=FRAC- 1 .0  BESK1050 

Bl(I+2)=CeNST»FRAC»BI(I*l)+BI<I)  BESK 1060 

52  BK(I+2)=    -C0NST»FRAC»aK( 1 ♦! )+PK( I )  BESK1070 

G0  T0  39  BESKlOeO 

END  BESK1090 


BESV  -  REAL  BESEEL  FLNCTI0NS  -  F0BTR*K  tl  C0OeO 

CBESSY  NYC  MAT!-  tTlLITY  SUBH0UTINE  F  0R  EFSSEL  Y  3/15/64  F.  B  AGUSABE  S  Y  00 1 0 

SueRULTINC  BESSY(X .FNU.N.BJ.BY )  BESY0020 

DIMENSleK  BJ(l).BYtl)  BeSY0030 

EQUI VALENCEtPy.VF »  BESY0040 

C  BESYOOSO 

XSAVE=X  BESY0060 

M1=N  BESY0070 

MF=131070  BESY0080 

bJ( I )=FM  BESY0090 

CALL  RESSJ( X .FMC.N.BJ )  BESYOIOO 

MF=N  BESYOllO 

Byii)=Ff  BESYOIZO 

YNU=eYt 1 )  BeSY0130 

N=Ml  BESY0140 

«Y(2)=X  BESYOISO 

X=XSAVE  BESY0I60 

C  BESV0170 

NN=XARSF(N)  BESYOISO 

Nl=NN-l  BESY0t90 

C«NST=2.0/X  BESYOaOO 

PI  =  3.  14  l£?2e54  BESY02iO 

C  BESY0220 

IF(X-IO.O)  30.19,19  BESY0230 

30     XlO=X+25.  BESY0240 

K1C=X10  BESY0250 

N1C=NN+10  BESY0260 

M=XMAXOF ( K lO.Nl 0 )  BESY0270 

C  BESY02eO 

IF(X-l.O)   1.1.3  BESY0290 

1  KP=1 72.693ee/( 3.€eee795-L0GF (X) )  BESY0300 
M=XMIN0F(M.KP)  BeSY03I0 

G0  T0  2  BESY0320 

3       KP=3<;.«X«». 3333333  BESY0330 

M=XMIN0F{M.KP)  BeSY034C 

2  M=M/2  BESY0350 
K=2»M*l  BESV0360 
ARG=FNU«PI  BESY0370 
GARG  =  GAyN'AF(1.0  +  FNU.0)»»2  8ESY03aO 

C  BESY0390 

C         Ce^PUTE  GA^'^'A  ZEW«  EOO.   15. PG.  5  .  IF  NU  =  0  LSE  EOU.   16.  BESY0400 

C  BESY0410 

14  IF(FNU)   15.ie.l5  BESY0420 

15  TERM  =(1.0/Pt)«  C0NST  ••(2.0«FNU)  BESY0430 
GAM1=C0SF(ARG)/S1NF(ARG)-IERK»(GARG/FNU)  BESY0440 

C        C0.MPUTE       GAVWA    0NE  F0R  NL  N0t  EQUAL  ZER0.                          BESY0450 

GAM2=2.0  •  TERM  •  GARG  •  (FNL*2.0)  /  (I.O-FKU)                         BESY0460 

G0  T0  10  BESY0470 

C  BESY04a0 

C                     C0>«PUTE     GAM^A     ZER0     AND  0NE    FBB     NC    EOLAL     ZERB.                                                                  BESY0490 

16  TL0G=L0GF (X/2.0)  BESYOSOO 
A=57. 72 1566496-2  BESY05IO 
PIF=2.0/PI  BeSY0520 
GAM  l=PI(-»  (  A  +  TL0G  »  BESY0530 
OAM2=4.0/PI  BESY0540 

C  BESY0S50 
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CCMPUTit  GA>/yA,  YNL.  AND  0V(1),  AND  BY(2) 
EQLATI0KS   15.17,   AND   18. 

QY(2)    =0.0 

BY( 1 )=0.0 

GAM3=0.0 

e  l=-(  I.O/M  I  )»C<1NST   ••(  I.Ct2.0»FNL»  •  GARG 

BY(  2  )=ei«ej(  1  )*BY(2) 

ei=GAMl-GAM2/i!.0 

BY( 2)=E  1«HJ(2  )+BY(2) 

YNU=GAM 1»8J ( 1 ) 

TXNU  =  3. 0»FNU/ X 

AB  =  ABSF(BJ(  1)  )-. 000005 

12=1 


DH   11   I =2 .MPl 

12= 12*2 

F  1  =  1 

F  IM=I-1 

FI2=2»1 

DEN0M=   FI»  (FI-FNU)«(FNt*FI2-2.0) 

GAy3=(FNU  +  FI2  )»(2.O«FNU  +  FIM)«(FNl,  +  FIK)/OEN0f 

GAMJ=-GAM^«GAM2 

YMl,  =  GAM2«HJ(  I2)*YNU 

1F( AQ  )   10.  ie.23 

WHEN  J(NU)   IS  NEAR  ZER0  Ce^'PLTE  eY(2)  FRBy  EG. 

C  t  =  TXNL»GAM2 

0Y(2  )=C 1«BJ(  I2)»BY(2) 

IF  C  I2-K  )  25.  I  10.  1  10 

t 1  =  (GAM2-GAy3  )/2.0 

8Y(  2  )=E  1»HJ(  I  2<-l  )+BY(2) 

GAM l=GAy2 

GAy2=GAM3 

0Y( 1 )=YNC 

IF(  AB  )   19.  1<3,  17 

DY(2)=(YNL»eJ(?)-2.C/(PI»X))/aj(l) 

IF  N  =  C  «n     1  GP)  fLT   ALL  HY  S  C0MFUTEO. 
IF(N)  50.49,20 
IF(N-l)  <.9.49.21 

C0MPLTC  Y(N*l)  BY  RECLRRENCE 

OH  22    1  =  1  ,N  1 

F  I  1  =  1 

dY(I  +  2)=C(?NST»(FIl+FNL)»eY(I*l)-eY(I) 

WETUHN 
IF(FNU-.5CC0CC )  54.53.54 
FIY(  2  )=flj(  1  ) 
IF(NN-  1  )  49.6  1  .60 
AHG=- 1 .0 


18. ELSE  EC. 


BESY0560 
BeSY0570 
RESYOSeO 
BESYOS'SO 
BESYOeOO 
8ESY0610 
BESY0620 
BESY0630 
BESY064C 
8ESY0650 
BESY0660 
BESY0670 
8ESY0680 
BESY0690 
BESY0700 
BeSY07lO 
BESY0720 
BESY0730 
BESY0740 
OESY0750 
BESY0760 
BESY0770 
BeSV0780 
BESY0790 
OESY0800 
BESYOaiO 
BESY0fl20 
RE5Y0830 
BESY004C 
BESYOeSO 
flESY0860 
OESY0a70 

BESYoeao 

BE5Y0a90 
DESY0900 
BE5Y0910 
BESY0920 
BESY0930 
BESY0940 
BESYOgSO 
BESY096C 
BESY0970 
BESYOgeO 
OESY0990 
BESYICOO 
BESYIOIO 
BESY J020 
BESY103C 
BESY104C 
BESY1050 
HESY1C60 
BESY 1C70 
BESYlOaO 
OESY1090 
BESYl 100 
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FeRTfJAN 


BY( 3 )  =  4RG»BJ(2  ) 

BJ(2)  =  C0NST»FM,»BJ(l  )-BJ(2) 
ARC=-ARG 

IF     (NN-2)        49.51.56 
56        0«     55         1=2. M 

BYC  1*2 )  =  ARG«RJ(  1*1  ) 

55  ARG=-ARG 

00     T0     51 
51        BY(2  )=CaNST»FNIj»eY(  1  )-BY(  2) 
BJ(2)=Cl!NST»FNU»6J(I)-flJ(?) 
IF(NN-l)     49.09.51 
>1  FRAC=FNL 

D0  52    1=  1  .Nl 
FRAC=FRAC- 1 .C 

BJ(  I+2)=C0NSr»FRAC»BJ(  1*1  )->?J(  I  ) 
IF(FNU-.5C000 )  58.52.56 

56  BY(I+2)=C0NST»FRAC»BY(I<-1)-HY(I) 
52  C0NTINLE 

G0  TK  49 
>1     HJ( 2 )=C0NST»FMj»8J( 1 )-BJ(2 ) 


49 


END 


BESY  1  1  10 
BESYl 120 
BESY I  130 
BESYl 14C 
BESYl 150 
BESYl 160 
BESYl 170 
BESYl 180 
HESYl 190 
HESY1200 
HESY 1210 
DESY 1220 
BESY 1230 
BESY 1240 
BESY 1250 
BESY1260 
BESY 1270 
BESY1280 
BESY 1290 
BESY1300 
BESYl 310 
BESY  1320 
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J,(x),  or  Y^(: 

Restrictions: 

a) 

X.  >  0  , 

b) 

0  <  X  <  10"5  , 

c) 

10-5  <  X   <   1.0 

d) 

1.0  <  X  ^  50 , 

e) 

X  >  50, 

Identification:   BES6  -  Single-Valued  Bessel  Functions 
Four  709^  FORTRAN  Il-Coded 
Function  Subprograms 

Purpose:   Given  x  and  v  to  compute  a  Bessel  function 

of  real  order  and  argument 

r  e~^I  (x)  or  e^K  (x)  . 


|v|  <  1 

'-'  <b.7'--Inx-^Q) 
|v|  <  (39  x^/^  -  10) 

|v|  <  134 
Method:   See  write-up  for  BESS. 

Usage:   To  compute  the  single  valued  Bessel  function  and 
to  store  the  result  in  RESULT 
RESULT  =  BES6j(X,FNUP,IVAR) 

RESULT  =  bes6k(x,fnup,]:var) 

RESULT  =  BES6y(X,FNUP,IVAR) 

RESULT  =  BES6i(X,FNUP,IVAR) 

where 

X      is  the  argument  (X  >  0  ) 

FNUP    is  the  order  v 

IVAR    is  an  Integer  variable  which  is 

required  internally  by  the  routines 
Accuracy:  The  accuracy  is  variable,  depending  on  the 
parameters  and  the  function  desired.   For 
function  values  less  than  .1,  all  functions 
seem,  to  give  at  least  6  decimal  place 
accuracy  (not  necessarily  6  significant 
figures);  most  give  7  decimal  accuracy 
and  many  give  7  significant  figures.   For 
larger  function  values,  most  answers  seem 
to  be  correct  to  6  or  7  significant  figures. 
For  X  >  50,  the  accuracy  of  J  and  Y  will 
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essentially  depend  on  the  accuracy  of  the 
sin  and  cos  routine. 

Note:     These  functions  perform  in  the  same  manner 

as  the  subroutines  in  the  BESS  package .   The 
difference  between  them  is  that  the  functions 
here  return  a  single  answer  and  the  subroutines 
in  the  BESS  package  return  a  table  of  answers. 

Requirements: 

a)  Non-System  Subroutines 
BES6l  uses  GAMMA 
BES6j  uses  GAMMA 

BES6k  uses  BES6l  and  GAMMA 

BES6y  uses  BES6J  and  GAMMA 

where  GAMMA  is  a  function  subprogram  which 

computes 

/  e'^  u-^"^du  ,  for  Y  >  0 

Y 
and  is  used  in  the  following  manner: 

ANS  =  GAMMAF(A,Y) . 

The  subroutine  GAiyiMA  listed  in  this  report 

is  a  routine  that  fulfills  these  requirements. 

b)  System  Library  Functions  (closed  subroutines) 
BES6l  uses  EXP,  L0G,  SQRT,  XL0C 

BES6J  uses  C^S,  L0G,  SIN,  SQRT,  XL0C 
BES6k  uses  EXP,  L0G,  SIN,  XL0C 
BES6y  uses  C0S,  L0G,  SIN,  XL0C 

c)  System.  Built-in  Functions  (open  subroutines) 
BES6l  uses  ABS,  XABS,  XMAXO,  XMINO 

BES6j  uses  ABS,  XABS,  XMAXO,  XMINO 

BES6K  uses  ABS,  XABS,  XMAXO,  XMINO 

BES6y  uses  ABS,  XABS,  XMAXO,  XMINO 

d)  Storage 

BES6i   llllio  =  ^^^^S   locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
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BES6j  1089^q  =  2101g  locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
BES6k  848-j_q  =  I520g  locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
BES6y  857^q  =  I53I3  locations  plus  the 

required  subroutines  listed  in  a)  and  b) 
Authors:   Florence  Ragusa  and  M.  Goldstein 
Date:   March  1964 
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SINGLE-VALUED     REAL     BESSEL     FUNCTIBh 


FBRTRAN      I  I     CaOt=0 


F.  WAGtiS/ 


LriESel  NYU  VATI-  UTILITY  oeSSEL   I  FUNCTieN    3/'l5/6< 

FONCTIUM  etSe I ( X.FNUP. I VAH ) 
C  I  VAR  IS  A  DUf^Y  VARIABLE  *l-ICt-  IS  SET  T0 

C  1J1070  WHEN  BESI   IC  CALLED  RY  eESK. 

C 

C1MENSI0N  HI ( 150) 
C         IDIM  AGREES  ftlTI-  THE  DIVEKSICN  Fe  R  EI.  T0  CHANGE  DIMe^SI0^ 
C  CHANGE  OIMENSIHN  STATEMENT  AND  IDIV. 

C 

ID  I^'  =  l  50 
I  Y  =  l 
IF ( IvAR-131070)  2,1,2 

1  IY  =  2 

2  I VAH  =  XLHCF(OI  ) 
R=FNUP 

N=0 
FNU^O.C 

IF ( R )     22.29,25 
22  \A  =  -\ 

22  R=H+1.0 

FNU=R 

IF(R)     2'i,27,27 
2  4  N  =  N -  1 

FNU=R 
G0     T0     22 

25  FNU=R 

R  =  fJ-1.0 

IF(R)     27.26,26 

26  N=N+1 

GH     T0     25 

27  IF(FNU)     2e,2e,29 

28  N=XAeSF(N) 
FNU=AeSF ( FNU ) 

2<3  NN  =  XARSF(N) 

C0NST=2.C/X 

IF ( X-50.  )      30,17,1^ 
JO  X10=X+2£.C 

K 1C=X  10 
N10=NN+  IC 
M=XVAXOF  (K  lO.MO  ) 
C 

IF  (X-  1.0)      3,<iC.<tC 

3  KP=172.6<J3ee/(  3.6eee795-L0GF<X)  ) 
M=XM I NOF  ( M  .KP  ) 

GH  T0  A 

c 

40      KP=3q.»X»». 3333333 
M  =  XK'INOF  (  ►'.K^'  ) 

4  M=V/2 
K=2«Mtl 

IF  (K  +  2- IC  II"  )  42,42,305 


K2=K+ 1 
K.3  =  K*2 
H I (K2 )= 1 .Ce-37 


BEeiOOlO 

85  6  I  0020 

86610030 

OEMOOAC 

DE6I0050 

BE610060. 

QE6I0070 

BE6IOOaO 

HE6I009C 

BEOIOIOO 

0E6I 0110 

BE6I0120 

HE6I0130 

BE6I014C 

BE6I0150 

BE6I0160 

BE6I01 70 

BE6I0ieC 

BE6IOigO 

BE6I0200 

BE6I0210 

BE6I0220 

8E6I0230 

BE6I0  24C 

BE6I0250 

Be6I0260 

BE6I0270 

BE6I02eO 

BE6I0290 

BE6I0300 

Be6I03lO 

BE6I0320 

HE6I0330 

BE6I034C 

BE6I0350 

HE6I0360 

BE6I0370 

HEftI03aC 

BE6I0390 

BE6I0400 

BE6I0410 

BE6I0420 

8E610430 

HE6I044C 

BE6I0450 

BE6I0460 

RE6I0470 

BE610480 

RE6I0490 

BE6I0S00 

BE6I0S10 

BE6I0520 

BE  6 10530 

BEfjI054C 
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eesei  -  single-valued  bfal  bessel  functibn  -  f0RTran  ii  cacEO 

BI(K3)=0.C  86610550 

00  5   L=1.K  eE6I056C 

I=K+1-L  BE6I0570 

FLI=I  HE6I05eO 

5  BI (  I  )=CeNST»(FLI+FNU)»8I  (  I  +  l  )*H1  {  1*2)                                     BE6I0590 

BE6I0600 
IF(X-lO.O)  e.l7.l7  BE6I06J0 

6  PSI=2.0« (FNL+ 1.0)  BE6I0620 
ALF  =  PSI«e  1(2  )  +81  (  1  )  BE6I0630 
Kl=K-l  BE6I064C 

Dia  7    1=2. Kl  BE6I0650 

J=I+1  BE6I0660 

FLI=I  BE6I0670 

FIM=I-1  BE6I068C 

TEMP={(FNL+FLI)«(2.0«FNL*F!M))/(FLI«(FNU+Fiy))»PSI  BE 610690 

PSI=TeMP  86610700 

7  ALF=PSI«R  I  (  J)-»ALF  BE6I0710 

BE6I0720 
ALF  =  C(?NST»«FMJ«GAMWAF(FNI;+1.0.0)«ALF  BE  61  0730 

BE61074C 
Ilri  BE6I0750 

8  00  9    1=11. K  BE610760 

9  BI  (  I  )=ei  I  I  )/ALF  BE6I0770 
HESSL=QI (NN+ 1 )  BE6I0780 

BE6I0790 
BE6I0800 
BE6I0810 
BE6I0820 
:  (  1  )  +81  (2 )  BE6I0830 

BE6I0e4C 
8E6I0e50 
BE6IC860 
BE6I0e70 
BE6I0880 
BE610890 
BE6I0900 
BE6I0910 
1(1)  BE6I0920 

BE6I0930 
BE6I094C 
BE610950 
HE6I0g60 
BE6I0970 
BE6I0980 
PE6I0S90 
BE6I 1000 
8E6I1010 
BE61 1020 
8E6I 1C30 
8E6I lOAC 
RE6I 1C50 
BE6I 1060 
BE6I 1070 
BE6I 1080 
BE6I 1C90 
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IF (N )   10, 

.14.14 

10 

IF(  IY-2  ) 

13.15.13 

13 

HI(2  )=C0f 

^ST«FMU«B 

OESSL=BII 

[  2  ) 

C 

IF(  NN-  1  ) 

14.14.1 1 

c 

C0  12    1=1. Nl 

FRAC=FRAC- 1 .0 

BI(I*2)  =  C0NST»FHAC»t1I(r 

12 

BeSSL=B 1 ( I +2 ) 

C 

1  4 

00  T0  {  le.  15)  ,iv 

15 

X  =  FK1 

FNLP=FK2 

16 

BESei=  BESSL 

RdTUHN 

17 

IF(NN+1- IDIW )  43.43.305 

43 

K01.NT=1 

GNL=FNU 

C0=.25 

CI  =.15625 

C2  =-.375 

C3  =. 1 171fi/S 

C4  =-1.  15625 

C5  = 1 .U75 

Cb  =.095214£4375 

EESei  -  SINGLE-VALUED  REAL  BESSEL  FUNCTieN  -  FBHTRAN  II  CaCED 


C7  =-2.36671675 

Ce  =14.226=625 

Cq  =-19.66750 

C lC=8.0932ei719E-: 

C  1  l=-4.  100565937 

C12=5f .220609375 

C13=-277. 87500 

C14  =  35'>.3750 

C15=. 0416666666 

C16=-.2S 

C 1 7=. 125E-1 

Cie=-.350 

C19=. 000556035716 

C2C=-  .4241071426 

€21=3.60267657 

C22=-5.625 

C23=. 0030381944 

C24=-.466  11  1 

025=10.26645833 

C26=-58.0 

C27=7e.75 

le  ALl=GNO»»2-.25 
A2  =C0»AL1 
A4  =CI«AL1 
A4=( A4  +  C2  )»AL  1 
A6=C3»AL1 
A6=(  Ae+C4  )»AL  1 
A6  =  ( Ae+C5 )«AL  1 
A8  =  C6»AL  1 
A8=(Ae+C7   )«AL1 

Ae=(A8+ce  )»ALi 

Ae=(A8+C9   )«AL1 
A IO=C 10«AL 1 
A1C  =  (  AIG  +  Cl  1  )«AL1 
A1C=(A1C+C12) 'AL 1 
A 10=( A10+C13) 'AL I 
A10=(  AlO  +  C  14  )  "AL 1 

19  P 1  =  3.  14 15926535879 
TS= l.O/X 


B=8»T2-Ae 
B=B»T2+A4 


DU' 


A2=.5«AL1 

A4  =  C15«AL  1 

A4=( A4+C16 )«AL1 

A6  =  C1  7»AL  1 

A6=(  A6+Cie  )«AL1 

A6=( Ae+.7£ )«ALl 


BE6I 1100 

BE6I 

11  10 

BE6I 

1120 

BE6I 

1  130 

BE6I 

1I4C 

6E6I 

1  150 

BE  6  I 

1160 

BE6I 

1170 

BE6I 

1160 

BE61 

1190 

8E6I 1200 

BE6I 1210 

BE61 

1220 

BE6I 

1230 

BE6I 1240 

BE6I 

1250 

BE6I 1260 

BE6I 

1270 

BE61 

1280 

BE6I 

1290 

BE6I 

1300 

BE6I 1310 

BE  6  I 

1320 

BE6I 

1330 

BE6I 134C 

BE6I  1350 

BE6I 1360 

BE6I 

1370 

BE  6  1 

1380 

BE6I 

1390 

BE6I 1400 

BE611410 

BE  6  I 

1420 

BE 6  I  14  30 

BE6I 

144C 

BE6I1450 

BE6I 

1460 

8661 1470 

BE6I 1480 

8661 1490 

BE6I 1500 

BE6I 1510 

BEbl 1520 

BE6I 

1530 

BE6I 1540 

BE6I 

1550 

BE  6  I 

1560 

BE6I 

1570 

BE6I 1580 

8661 

1590 

8E6I 

1600 

8E6I 1610 

BE  6  I 

1620 

BE6I 1630 

8E6I 1640 

eesei  -  single- valued  real  bessel  flnctibn  -  fbrtran  ii  czced 

Ae  =  Cl<5»ALl  BE6I1650 

A8=( Ae+C2C)«ALl  BE6i:660 

A8= ( A8  +  C2  1  ) 'ALl  HE6I1670 

Ae={ Ae+C22 )»ALl  BE611680 

AlC=C23«ALl  BE6I1690 

A10=< A10+C24 )«AL1  BE6IJ700 

A10=( A10+C25 ) 'ALl  BE611710 

A10  =  (  A10  +  C2e  )»AL1  BE6I1720 

AIC=( A10+C27) "AL 1  Be6I1730 

BE6I J740 

B=-A1C»T2+Ae  BE611750 

B=B«T2-Ae  8E6I 1760 

E=B»T2tA«  BE611770 

B=B«T2-A2  BE6I1780 

CNti  =  e»T2  BE611790 

HE  6  I  1800 

cO     Fl=C0VT»SQWTF(TS/(PI«2.))«EXPF(8NL«X)«(l.-tXPF(-2.»X»(l.tfcNU)))  BE  61  1810 

FKl=D0VT«SG«TF((PI»TS)/2.)»ext;F(-X»eNL)  BE  61  1820 

BE6I 1830 

IF  (K0LINT-1)   121.121.122  BE6I184C 

!l     FSAVE=F1  BE6Iie50 

FKSVE=FK 1  BE6I 1860 

GNL=FNU+1.0  BE6I1870 

K0LNT=2  BE6I1880 

ca    ifi    le  BE6ii8gc 

BE6I 1900 

>i     F2=Fl  BE61191C 

FKi=FKl  BE6I1920 

8E6I 1930 
BE6I 194C 
BE61 1950 
BE6I 1960 
124 . 124 . 12S  BE6I 1970 

BE6I 1980 
BE6I 1990 
BE6I2000 
BE6I2010 
BE6I2020 
BE6I2030 
8E6I204C 
BE6I2050 
BE6I2060 
BE6I2070 
BE6I2080 
BE612090 
BE6I2100 
BE6I21 10 
BE6I2120 
BE6I2130 
OE6I2140 
QE6I2150 
BE6I2  160 
BE612170 
BE6I218C 
BE6I2190 


F  1=FSAVE 

FK  l=FKSVfc 

IF(  X-50.  )      123.127.12 

c 

12:- 

IF(  AOSF(F  1  )-AB5F(F2) 

12^ 

ALF=0I ( 2)/F2 

GH     T«      12e 

c 

12t 

ALF  =  GI  (1  )/F 1 

12t 

DI  (  1  )=F1 

Bl( 2)=F2 

G0  T0  e 


12  r 

HI(  1  )=F  1 
HI (2)=F2 
IF(N)      10.  13C.  128 

I2t 

IF(N-1  )      13C.  131  .  129 

C 

i2<; 

FL 1=0.0 

DH     132         1=3. M 

FL  I=FL I ♦ I  .0 

132 

OKI  )=-(C0NST»(FNL  +  FLI  )*BI  (  I- 
BESSL^HKNI  ) 

-I  ) 

-61(1-2)) 
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eesei  -  single- valued  real  bessel  flnctibn  -  fbbtban  ii  cacED 

I3C     aESSL=Bl(l)  BE6I2200 

Oe  T0  11  BE6I2210 

C  8e6I2220 

131  BeSSL=BI(2)  BE6I2230 

G«     T0     14  .  BE6I22A0 

C  BEM2250 

iO'z         IVAR  =  0  HE6I2260 

C0  20t     I=1.ICIW  86612270 

JOt   HI  (  I  )  =  0.0  BE61 2280 

UESSL=0.0  06612290 

CH  T0   lA  BE6I2300 

tNU  BE6I2310 
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eES6J  -  SINGLE- VALUED  HEAL  GESSEL  FLNCT I 0N  -  FORTRAN 


CaeifcJ  NYU  MATH  UTILITY  BESSEL  J  FU^CTIe^    3/15/64       F.  RAGUSA  BEftJOOlO 

FUNCTIKN  PESe J(X.FNUP.  IVAS)  BEeJOOSO 

C  BE6J0030 

C  IVAR  IS  A  DUNKY  VAC. WH ICH=J 31070  WHEN  J  CALLED  BY  V.     8E6J004C 

C  BE6J0050 

CIVENSI0N  EJ(ISO)  BE6JC060 

C  BE6JC070 

C        IDIK  SPECIFIES  ARRAY  SIZE  ^F     EJ.   IF  ARRAY  SIXE  T0  QE  CHANGED  THEN  BE6J0080 

C        CHANGE  DI^EKSIBK  STATEMENT  AKC  ICIM.  BE6J0090 

ID  1^= ISO  BE6 JO  1 00 

JY=1  BE6J0110 

IF ( I VAR-131070)  2.1.2  BE6J0120 

1  1Y=2  BE6J0I30 

2  I  VAR  =  XL0CF  (HJ )  8E6J014C 

K=FNUP  BE6J0150 

N=0  BE6J0160 

FNU=0.0  BE6J0170 

IF(R)3.10.e  BE6J0180 

J  N=-l  BE6J0190 

4  R=R+I.0  BE6J0200 

FNU=R  BE6J02iO 

IF(H)5.8.e  BE6J0220 

ci  N  =  N-l  flE6J0230 

FNU=R  BE6J024C 

GU  T0  4  BE6J0250 

e  FNU=R  BE6J0260 

H=H-1.0  BE6J0270 

BE6J0280 
Be6J029C 
BE6J0300 
BE6J0310 
BE6J0320 
BE  6  JO  3 30 
BE6J034C 
BE6J0350 
BE6J0360 
8E6J0370 
BE6J03eC 
BE6J039C 
BE  6 J  0400 
BE6J04  10 
IF(X-l.O)   12.13.13  8E6J0420 

BE6J0430 

12  KP=172.693ee/( 3.e8ee795-LeGF (X) )  BE6J044C 
M  =  XMNCF(I'.KP  )  BE6J0450 

G»  T0  14  BE6J0460 

BE6J0470 

13  KP=3<5.»X»«. 3333333  BE6J04aO 
M  =  X^'I^OF(^.KP  )  BE6J0490 

I/,     f/  =  M/2  HE6J0S00 

K=2«Mtl  BE6J0510 

TEST  K+2  T0e  LARGE  F0R  DIVENSiaN  BF  EJ.  HE6J0520 

IF(K+2-ICIM)   15.15.43  RE6J0S30 

15     ej(K+l )=l.Ce-37  BE6J0S4C 


IF(R)a.7.7 

N=N+1 

G0  T0  6 

IF(FNU)g.9. 10 

N=XABSF(N) 

FNU=AeSF(FNU) 

NN=XA8SF(N) 

C0NST=2.C/X 

IF( X-SO. )   11, 

.20.28 

X10=X+25.C 

K10=X1C 

N10=NN»1C 

M=XMAXCF (K lO.N 10) 
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BESej  -  SINGLE-VALUeO  REAL  BESSEL  FUNCTieN  -  F0RTRAN  II  C0CEC 

DJ(K*2)=0.C  BE6J0550 

D»  16  L=l.K  BE6J0560 

I=K*l-L  BE6J0570 

FLI=I  .        8E6J0580 

BJ( I )=C0NST»(FLI>FNU)«BJ< 1*1 )-BJ( 1*2)  BE6J0590 

16  CONTINUE  BE6J0600 

BE6J0610 
FIND  ALPHA. ECU. 12. PG. 4  WHEN  X  LESS  THAN  10.  BE6J0620 

en    FR0M  BESSEL  FLNCT.  F0R  LARGE  ARG.  BY  G0LCSTEIN.  BE6J0630 

BE6J064C 
IF( X-10.0)  17.28.28  BE6J0650 

BE6J0660 

17  PHI=FNL*2.C  BE6J0670 
ALF=PHI«BJ(3)+BJ( 1 )  BE6J0680 
M0=3  BE6J0690 
00  18  1=2. M  BE6J0700 
N<0=M042  BE6J0710 
FM2=2*I  BE6J0720 
FMl=I-l  .  Be6J0730 
Fl=l  BE6J0740 
TEMP=(  (FNU*Fy2)»(FNL+FMl  )  )/(FI•(F^L♦F^'2-^.0)  )»PHI  BE  6  JO  750 
PHI=TEMP  BE6J0760 
ALF  =  PH»BJ(M0)*ALF  BE6J0770 

le  C0NTINLE  BE6j07eO 

BE6J0790 

ALF  =  C0NST««FNU     •GAyMAF(FNlJ+l  .C.O)«ALF  BE6J0800 

BE6J0ei0 

11=1  BE6J0a20 

BE6J0830 

19  C0  20  1=11. K  BE6J0e40 
BJ(  I  )  =  BJ(  I  )/ALF  BE6J0e50 

20  CaNTINLE  BE6J0e60 
BESSL=BJ(NN+1 )  BE6J0e70 
IH(N)2  1,25.25  BE6J0e8C 

21  IFt  IY-2)22,2e.22  BE6J0e90 

22  8J(2)=C0NST»FNL«BJ(1 )-BJ(2)  BE6J0900 
BESSL=BJ(2)  BE6J0910 

Be6J0920 

IF(NN-I)2E. 25.23  BE6J0930 

23  FHAC=FNU  BE6J094C 
N1=NN41  BE6J0950 
00  24  L=3.Nl  BE6J0960 
FHAC=FRAC- 1 .0  BE6J0970 
BJ(L  )  =  C0NST»FRAC»B J(L-1  )-ej<L-2)  BE6j09e0 

24  C0NTINUE  BE6J0990 
BESSL=ej(NN+ 1 )  BE6J1000 

BE6J1C10 

ib     G0  T0  (27.26). lY  BE6J1020 

2t     X=Y1  BE6J1030 

FNUP=Y2  BE6J104C 

27  BESej=BESSL  HE6JI050 

RETURN  HE6J1060 

QE6J1070 

BE6J loao 

C0MPUTC     J(l)     Fueiy     M.G0LDSTEIN     PAPER     BESSEL  BE6J1090 
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eESeJ  -  SINGLE-VALUEO  REAL  BESSEL  FUNCTIBN  -  F0RTRAN  II  C0DED 

FUNCTIONS  F0B  LARGE  ARGUMENTS.  BE6J1100 

BE6JI1 10 

?b   IF(NN+l- ICIM >  29. 29. A3  BE6J1120 

?9  Kt)UNT=l                                                       .  BE6J1130 

GNU=FNU  BE6JI14C 

CO  =.25  BE6J1150 

CI  =.15625  BE6J1160 

02  =-.375  BE6J1170 

C3  =.1171675  BE6JlieO 

C4  =-1.  15^25  BE6JI190 

C5  =l.e75  BE6JI200 

C6  =.09521464375  BE6J1210 

C7  =-2.36671675  BE6J1220 

CO  =14.2265625  BE6J1230 

C9  =-19.66750  BE6J124C 

C1C=8. 093261 719E-2  BE6J1250 

CI  l=-4.  100585937  BE6J1260 

C12=58. 224609375  BE6J1270 

C12=-277. 67500  BE6J1280 

C14=354.375C  BE6J1290 

Cl£=. 04 16666666  BE6JI300 

C16=-.25  BE6JI3I0 

C17=.125E-1  BE6J1320 

Cia=-.35C  BE6J1330 

C  19=. 000556035716  Be6J1340 

C20=-  .4241071426  BE6J1350 

C21=3. 60267657  BE6J1360 

C22=-5.625  BE6J1370 

C23=. 0030361944                                                   ^  BE6J1380 

C24=-. 466111  BE6J1390 

025=10.26645633  BE6J1400 

C26=-5e.C  BE6J1410 

027=76.75  BE6J1420 

BE6JI430 

30  AL  l  =  GNL»»2-.25  BE6J1440 

A2  =CO»ALl  BE6J1450 

A4  =CI«AL1  BE6J1460 

AA=(  Aii  +  Cc  )»AL  1  BE6J1470 

A6=C3»ALl  BE6J1480 

A6=( Ae+Ca )»AL I  BE6J1490 

A6=( A6+C5 )«AL I  BE6JI500 

Ae=C6»ALl  BE6J1510 

Aa=(Ae+C7   )»AL1  BE6J1520 

Ae=tAe+ce  )«ali  be6J1530 

Ae=(A8+C9   )«ALl  8E6J154C 

A1C=010«ALI  Be6J1550 

A1C=(  AlO  +  Cl  1  )  »AL 1  BE6J1560 

A1C=( A10+C12 )»AL1  BE6J1570 

A 10  =  (  A IC  +  C13 ) "AL  I  BE6J15eO 

AIC  =  (  A 10tC14  )»AL1  BE6J1590 

BE6J 1600 

PI=3. 14 1592654  8E6J1610 

TS=1.C/X  eE6J1620 

T2=TS««2  BE6JI630 

eE6JI640 
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eeS6j  -  SINGLE-VALUED  REAL  PESSEL  FtNCTIBN  -  FBRTRAN  II  CeCED 


B  =  E 

!«T2+A« 

B  =  E 

BNL 

i=R»T2+l.C 

ANL 

=RNt/SGfiTF ( .5«l 

PAGE     20.     eOLATIBI 

A2  = 

.5»AL1 

A<»  = 

C15«AL1 

A4  = 

( A4+C 1 6 ) 'AL 1 

A6  = 

CI  7«AH 

A6  = 

( Ae  +  cie  )«ALi 

A6  = 

(  Ae+  .7S  )*AH 

A8  = 

C19«AL  1 

A8  = 

(Aa*C2C)»ALl 

Aa  = 

( Ae  +  C2  1  )»AL1 

Ae  = 

(A8*C22)»AL1 

AlC 

=C23«AL1 

A  10 

=( A10+C24)«AL1 

AIO 

=( A10+C25)»ALl 

AlC 

=  ( AlC  +  C2e  )«AL1 

AlC 

=( A10+C27)»AL1 

H=A 

10«T2-fAe 

D=e 

•T2+A6 

B  =  e 

•T2+A4 

B  =  R 

•T2+A2 

TPI-I  =  B«T?*1.0 

PH  I 

=TPhI»X     -(GNL+. 

CUP: 

=  C0SF(PH  ) 

SIP^ 

:SINF(PHI  ) 

12  T0  GET  PHI  ZERB 


)• (PI/2.0) 


Y1=ANL«SIP 

IF(KC!UNT-1  )31 

FSAVE=F 1 

Y3AVg=Y 1 

GNU=FNU+ 1 .0 

K0LNT=2 
GH  T0  30 


F 1=FSAVE 
Y1=YSAVE 


3  IF|AHSF(F 1 )-AebF(F2) )34,3A, 35 


BE6J 16S0 

BE6J 1660 

BE6J1670 

BE6J16e0 

BE6J 1690 

BE6J 1700 

BE6J 1710 

BE6J1720 

8E6J1730 

BE6J 174C 

BE6J1750 

BE6J1 760 

BE6J 1 770 

8E6J1780 

BE6J17q0 

BE6J1800 

BE6J 1810 

8E6J 1820 

BE6J 1830 

BE6J184C 

BE6J 1850 

BE6J1860 

BE6J1870 

BE6Jie60 

BE6J 1890 

BE6J1900 

BE6J 19  10 

GE6J1920 

BE6J 1930 

BE6J194C 

BE6J1950 

BE6J 1960 

BE6J 1970 

BE6J19eO 

BE6J 1990 

aE6J2000 

BE6J201C 

BE6J2020 

BE6J2030 

HE6J204C 

HE6J2050 

BE6J2060 

BE6J2070 

BE6J2080 

BE6J2090 

BE6J2100 

BE6J21 10 

BE6J2120 

BE6J2  130 

BE6J214C 

BE6J2150 

HE6J2160 

BE6J2170 

BE6J2iaO 

HE6J2190 


eesej  -  single-valued  real  bessel  fcnctibn  -  fbrtran  ii  cecec 


ALF  =  BJ( 2  )/F2 
Qii     T0  36 

ALF  =  BJ(  1  )/F  1 
BJ(  I  )=F1 
HJ( 2  )=F2 


00 


ra  19 


DJ( I )=F1 
blJ(2)=F2 
IF(  N)  21 ,38. 39 
BeSSL  =  CJ(  I  ) 
Of)  Tf!     25 

IF (N-1 )  3e.ac.4i 
PESSL=CJ ( 2 ) 
GH  Td  2S 


«2 


FL  I=FLI  +  1  .0 

8J(I)=CHNST«(FNL+FLI)»BJ(l-l>-BJ(I-2) 

BESSL=BJtN 1 ) 

GH  T0  25 
IVAH=0 

L!gSSL  =  0.0 
C0  44   1= 1 , IDIM 
BJ(  I  )  =  C.O 
GB  T0  25 

ENC 


se6J2200 
Be6J22lO 
BE6J2220 
Be6J2230 
8E6J2240 
BE6J22S0 
BE6J2260 
BE6J2270 
BE6J22eO 
BE6J2290 
BE6J2300 
HE6J2310 
BE6J2320 
HE6J2330 
BE6J2340 
Be6J2350 
BE6J2360 
BE6J2370 
BE6J2380 
BE6J2390 
BE6J2A00 
BE6J2410 
BE6J2420 
Be6J2430 
8E6J244C 
BE6J2450 
BE6J2460 
BE6J2470 
BE6J2480 
BE6J2490 
HE6J2500 
BE6J2510 
BE6J2520 
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^ALUFD     REAL 


;SSEL     FLNCTIKf 


FisRTRAN    II    cecec 


IS/fj' 


RAGUS/ 


;fcK  NYU  l^'AIH  UTILITY  BESSEL  K  F^J^CT 
FUNCTIl^N  OESCKCX.FNLP,  I  VAH  ) 

IVARIS  A  OU^MY  VARIABLE  USEC  HY  BESK  ViHEN  CALLING  EESI. 
HESK  SETSIVAR=13I07C  G K I NG  INT0  RESI  AND  SESI  SETS 
I VAR=XL0CF(aI ) .  .HI   IS  TFE  NA^E  KF  THE  ARRAY  WHERE  BESI  H/ 
ST0REC  THE   I  VALUES.    BESI  ALS0  SETS  X=:8K(1)  VALUE 
ANC  FNUP  =  (3K(£) 
*I-ICH   IT  C0MPLITES  IF  X  IS  GREATER  THAN  10.0. 

DIWENSI0N  BK (  150)  .BI  (  1  ) 

CHSHF(Z)=.5»(EXPF(Z)*{1.C/EXFF(2))) 
IUiy=150 
I  VAR= 13  1070 
SAVEX=X 
5AVENU=FNUP 
GeTI=  BESel (X .FNUP. IVAR) 

UPt!N      RETURN     BK(I)       IS      IN      X      IF 
ANC     BK (2)      IS     IN    F^UP 
ANC      THE      XL0CF      <1F      THE      ARRAY      ) 
BK( 1 )=X 
BK( 2)=FNUP 
X=S4VEX 
FNUP=SAVENU 

IF      IVAR     IS     ZER0     UPgN     RETURN     Fdef     BESI      THIS 
IF(  IVAR  )     £.1.2 

IF     IVAR      IS     ZtR0    FR^r'     BESI     THEN     X     0H     N     IS     Tgg     BIG    F0R    DIMtNSier 
1     D0     37     1  =  1  .  IDir/ 
'.7    BK(  I  )=C.C 
UESSL=0.0 
G0     T0     31 


V>AS     GR.     TH.     0R     = 
PESI      IS     IN     IVAR. 


10.0 


[S     ERR0S     SIGN. 


\.iiC  1=  I  VAR 
L0CP=XLfeiCF ( e I ) 

1C     GET     PR;1PER     INOE) 
KL=L0CP-LHCI+3?7te 

F41LLH»ING      T!1     BREAK 
R=FNUP 
N  =  0 
F-JU=:0  .0 
IF  (P  )      4.11,7 

R=R+l.O 

FNU=R 

IF (R )  6.9,9 

N  =  N-  1 

FNU=R 

G0  10  5 

FNU  =  R 

H  =  R-  1.0 

IF(R )  9,e.e 

N  =  N+1 
Gi^  T0  7 


VALUE  FaR  SUBSCRIPTING  BI  0F  EESI. 
jP  FNUP   INT0  FNU   ANC  N. 


BE6K0010 
BE6K0020 
fle6K0030 
BEfiKOOAC 
BE6K0050 
BE6K0060 
BE6K0070 
BE6K00e0 
BE6K0090 
BE6K0100 
BEt>KO  1  10 
BEt.K0120 
HE6K0130 
BE6k;014C 
HE6K0150 
BE6K0160 
BE6K0 170 
BE6K0180 
Be6K0190 
Be6K0200 
BE6K0210 
BE6K0220 
8E6K0230 
BE6K024C 
BE6K0250 
HE6K0260 
BE6K0270 
BE6K028C 
BE6K0290 
BE6K0300 
BE6K03 10 
BEf.K0  32  0 
BE6K0330 
BE6K034C 
BE6k;0350 
BE6K0360 
BE6K0370 
BE6K0380 
BE6K039C 
BE6K0400 
DEf>K04  10 
HE6K0420 
BE6K0430 
HE6K044C 
HE6K0450 
BEf>K0460 


8E< 


10470 


BE6KC480 
BE6K0490 
8E6K0S00 
HE^KOS 10 
BE6K0520 
OE6K0530 
Oe6K054C 
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12= 12*2 

HK(  1  )=DELTA2«ei(  I2)+BK(  1) 
BK( 1 )=BK( 1 )»exPF (2.0»X) 
00  TP)  2« 

H=.2 

Y  =  0.0 
bU^'  =  l  .0 
J  =  2 
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Be6K0580 
BE6K0590 


BESfK  -  SINGLE-VALUED  HEAL  BESSEL  FLNCTieK  -  F0BTBAN  tl  CZCEC 

9  :F(FNL)   tC.lC.ll  8E6K0550 

10  N=XAeSF(N)  BE6K0560 

FNU=AGSF(FNL)  BE6K0570 

11  NN=XABSF(N) 

Nl=NN-l 

CeNST=:2.0/X  BE6K0600 

IF(X-IO.O)   12.25.25  BE6K061C 

12  X10=X+25.  BE6K0620 
K10=X10  BE6K0630 
NIC=KN+1C  BE6K064C 
M=XMAX0F(K10.N10)  Be6K0650 
IF(X-l.O)   13.20.20  BE6KC660 

13  KP=  172.6^3388/ (  3. 6eee795-L«GFl  X)  )  BE6K0670 
M  =  XMINOF(l>'.KP  )  BE6K0680 

lA      M=M/2  BE6K069C 

K=2«M+l  BE6K0700 

C0NS2=C0NST    ••(2.0«FNU)  BE6K0710 

PI  =  3.  lA  1592653587^                               '  BE6K0720 

ARC=PI»FNt  eE6K.0730 

GARG=GAy^AF(FNU+1.0.0)»»2  BE 6K 0740 

TERV  =  C0NS2«GAfiG  BE6K0750 

15  IF<FNU)   16.17,16  BE6K0760 

16  DELTAl=-1.0/(2.0»FNU)»(ABG/'SIKF(AfiG>-TeRK)  BE6K0770 
0ELTA2  =  TeRI'«  (FNL  +  2.0)/t  l.C-FM;)  DE6K0780 
G0  T0  18  BE6K0790 

(-  BE6K0e00 

17  DELTA  l=-(  57. 721S66A9E-2*L0GF (X/2.C>  )  BE6KOeiO 
DELTA2=2.C  BE6K0e20 

(-  BE6K0830 

10      0K(  1  )=CELTA1«BI (KL*  1  )  BE6K084C 

I2=KL*1  BE6K0eS0 

ML1=M-1  BE6KC660 

1  BE6K0870 

BE6K088C 
BE6K0e90 
BE(.K09C0 
8E6K0910 
BEf>K0920 


D0   19    1=  1  .VLl 
IPl=Itl 
12=12*2 
FI2=2« IPl 
Fiy=I 
FI=IP1 

CENaM=F I»(FNU+F 12-2.0) •(FI-FNt)  flE6K09  30 

DELTA3=(FNl;  +  FI2)»  (  2  .  0  "F  NL-fF  I  y  )  •  (  FM.  +  F  I  M  ) /DE  N  0K  BE6K0  94C 

DELTA3=0ELTA3»0ELTA2 

HK(l)=DeLTA2»ei(I2)+BK(l) 

DELTA2=DELTA3 

C0NT INUE 


BE6K0g50 
BE6K0960 
RE6K0970 
BE6K09eC 
BE6K0990 
DE6K1000 
BE6K 10  10 
BE6K1C20 
DE6K 1030 
BE6K104C 
HE6K 1050 
BE6K 1060 
HE6K 1070 
RE6K 1080 
RE6K 1C9C 
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21  FACT=A.O  8E6K1100 

Y  =  V  +  I-  BE6K1110 

FY  =  EXPF(X«(  l.C-C0SHF(  Y)  ))»C0SHF(FNCI«Y)  BE6K1120 

SLM=SCM+FACT«FY  BE6K1130 

IFJJ-I)  22.23.23  BE6K1140 

22  J=J+l  BE6K1150 
FACT=2.0  BE6KI160 
Y=Y*H  BE6KI170 
FY=eXPF(X»(l.Q-C0SHF{Y)))»C0ShF(FNU»Y)  BE6KlieO 
SUM=SUM+FACT«FY  Be6Kll90 
J=J+1  BE6K1200 

GaT»2l  BE 6K 1210 

C  BE6K1220 

23  Y=Y*H  BE6K1230 

FY  =  EXPF(X«(  l.O-C0SHF( Y)  )  ) 'CO EMF < FNU* Y )  Be6K12«0 

SUM=SLM4FY  8E6K12S0 

SUy  =  SLM«  (t-/2.0)  BE6K1260 

EiK(  1  )  =StM  8E6K1270 

C  BE6K1280 

2a              BK(2)  =  (  (  1 .0/X  )-eK( 1  )»8I (KL  +  2)  )/BI (KL+1)  BE6K1290 

C  BE6K1300 

25  IF(N)  32,26.27  BE6K1310 

26  eESSL=eK(l)  BE6K1320 

00  T0  31  8E6K1330 

C  BE6K134C 

27  IF(N-2)     2e.2<3.29  BE6K1350 

28  BESSL=eK(2)  8E6K1360 

G0     T0     31  BE6K1370 

C  BE6K13eO 

29  00  30  1=1. Nl  BE6K1390 
FLI=I  BE6K1400 
aK(I+2)=CeNST»(FLl+FNU)»BK(I+l)+eK(I)  BE 6K 1410 
BESSL=eK( I+2>  BE6K1420 

30  C0NTINUE  BE6K1430 
C  BE6K144C 

31  bES6K=BESSL  BE6K1450 
RETURN  BE6K1460 

C  BE6K1470 

32  BK( 2)=-C0NST»FNL»BK( 1  )*BK(2)  BE6K1480 
IF(NN-l)    34,33.35  Be6K1490 

33  BeSSL=BK(2)  BE6K1500 
G0  T0  31  BE6K1S10 

C  BE6K1520 

J4      0ESSL=BK(1)  BE6K1530 

G0  T0  31  BE6K154C 

C  BE6K1550 

35  FRAC=FNU  BE6K1560 
00  36  1=1, Nl  BEbK1570 
FRAC=FRAC-l .0  BE6K1580 
BK(lt2)=-C0NST»FRAC»8K(I*l)*eK(I)  BE6IC1590 

36  bESSL=eK< 1*2 )  BE6K1600 
C  BE6K1610 

G0  re  21  BE6K1620 

END  BE6K1630 
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CBES6Y  NYL  MATH  UTILITY  BESSEL  Y  FLNCTIBK      3/15/64  F.  RAGUSA           BE6Y0010 

FUNCTI0N  eeS6Y(X,FNLP» IVAR)  BE6Y0020 

OI^'e^sIt!N  eY{  150)  ,BJ(  I )  be6yoo30 

C         IVAH  IS  A  DL''^Y  VARIAVLE  LSEC  BY  EESY  WHEN  CALLING  BESJ.  BE6Y0040 

C         BESY  SETS   IVAR  T0  131070  G0ING  INT0  BESJ.   LIP0N  RETURN  FH0M        BE6Y00S0 

C          BESJ  I VAR=XL0CF (BJ) .    WHERE  BJ  IS  THE  NAME  0F  THE  ARRAY  Be6Y0060 

C           WITHIN  BESJ  C0NTAINING  THE  J  VALUES.    IF  IVAR  =0  UPBN  RETURN     BE6Y0070 

C         THIS  IS  AN  ERR0R  INOICAT0R  FR0M  BESJ.  BEeYOOBO 

C  IF  N0  eRR0H  THEN  BESJ  ALSe  RETURNS  A  VALUE  F0fi  BK(1).  BK ( 2  )     BE6Y0090 

C              V»HEN  X   IS  GREATER  THAN  OR  EQUAL  TB  10. 0.    THESE  VALUES  BE6Y0100 

C             ARE  C0KMUMCATEO  T0  BESY  THHflUGH  X  AND  FNUP.  8E6Y0110 

IOII'=150  BE6Y0120 

IVAR=131C70  BE6Y0130 

SAVENU=FNUP  BE6YO140 

SAVEX=X  BE6Y0I50 

GETJ=  BESejI X. FNUP. IVAH)  BE6V0160 

BY(  1  )=X  BE6Y0170 

YNU=BY(I)  BE6Y0180 

BY(2)=FNUP  BE6Y0190 

X=SAVEX  8E6Y0200 

FNUP=SAVENL  BE6Y021C 

IF(IVAR)   1,36.1  BE6Y0220 

1      L0CJ=IVAR  BE6Y0230 

L0CY=:XL0CF  (BJ)  8E6Y0240 

KL=L0CY-L0CJ+327e8  BE6Y0250 

R=FNUP  BE6Y0260 

H=0  BE6Y0270 

FNU=0.0 

IF(R)  4,35.7 

4  N  =  -l 


BE6Y02a0 

7  BE6Y0290 

BE6Y0300 

R=R41.0  BE6Y0310 

FNU=R  BE6Y0320 

IF(H)e.9.9  BE6Y0330 

N=N-1  BE6Y034C 

FNU=R  BE6Y0350 

G0  T0  5  BE6Y0360 

FNU=R  BE6Y0370 

R=H-1.0  BE6Y038C 

IF(B)9,8,e  BE6Y0390 

N=N+1  BE6Y0400 

G0  T0  7  8E6Y0410 

IF(FNU)  34.34,35  BE6Y0420 

N=XAeSF(N)  BE6Y0430 

FNU=AaSF(FNU)  BE6Y044C 

NN=XABSF(N)  BE6Y0450 

N1=NN-1  BE6Y0460 

C0NST=2.O/X  BE6Y0470 

PI=3. 1415926:4  BE6Y0480 

IF(X-IC.O)  10,23.23  BE6Y0490 

X10=X+25.                                         ,  BE6Y0500 
K10=X10 
N10  =  NN+  10 

M  =  XMAXOF (K lO.N  10  )  BE6Y0S30 

IF(X-l.C)   11.2,2  BE6Y054C 


BE6Y0510 
BE6Y0520 


KP=35. 

•  X««. 

3333333 

M=XMIN 

OF  (  K, 

KP  ) 

M  =  V/2 

K=2«M*1 

AHG=FNC 

•PI 

GARG=GAWyAF ( 

I  . O  +  FNU 

.0)»», 

COMPUTE 

GAKN 

lA  ZER0.I 

EQUA. 

eES6Y  -  SINGLE-VALUED  REAL  BESSEL  FONCTieN  -  FBBTRAN  II  CBCED 

11  KP=i72.693ee/( 3.eeee795-LaGF (X ) )  Beevosso 

M  =  X^'INOF  (M.KP)  Be6V0560 

Q9I     T0  12  BE6Y0570 

Be6Y0580 
BE6Y0590 
BE6Y0600 
BE6Y0610 
Be6Y0620 
BE6Y0630 

;  BE6Y0640 

BE6Y0650 

5.PG.5.IF  NU  =  OUSE  E0LI.I6.  BE6Y0660 

C  BE6Y0670 

14  IF(FNLI)  15.  16.  15  8E6Y06aO 

15  TfcRf  =(  1.0/PI  )»C0NST«»(  2.0«FNlj)  Be6Y0690 
GAMl=C0SF(ARG)/SINF(AaG)-TERy«(GARG/FNU)  Be6Y0700 
GAM2=2.0«TERM»GARG»(FNU*2.0)/( 1.0-FNU)  BE 6Y 07 10 
G0  T0  17  BE6Y0720 

C  BE6Y0730 

C       C0MPUTE  GAVMA  F0R  NU=0.  Be6Y0740 

16  TL0G=L0GF( X/2.0)  BE6Y0750 
A=57.72156C49E-2  BE6Y0760 
PII-  =  2.0/PI  Be6Y0770 
GAM1=PIH»( A+TL0G)  BE6Y0780 
GAM2=4.0/PI  BE6Y0790 

C  Be6Y0800 

C       EQL)ATI0NS   15.17.18.  GAKMA  ,  YNU  .E  Y  I  1  )  ,B  Y  ( 2 )  BE6Y0810 

C  BE6Y0e20 

17  BY(2)=0.C  BE6Y0830 
BY( 1 )=0.0  Be6Y0840 
GAM  3=0.0  BE6Y0850 
El=-(  1 .0/PI )«C0NST««(  I .0*2.0»FNU)«GARG  BE  6 Y 0860 
8Y{ 2)=El«BJ(KL+l )*BY(2)  BE6Y0870 
El=GAMl-GAt'2/2.0  BE6Y0880 
BY( 2  )=E 1«B J(KL*2)+BY(2 )  BE6Y0890 
YNU=GAM1«BJ(KL*1 )  BE6Y0900 
TXNLi  =  3.0»FNU/X  BE6Y0910 
AB=ABSF(BJ(KL+1))-. 000005  BE 6Y 092  0 

MP1=M+1  BE6Y0930 

KST0P=1  BE6Y0940 

12=KL+1  BEeYOqSO 

D0  21   1=2. MPl  BE6Y0960 

12=12*2  BE6Y0970 

KSTaP=KST0P*2  BE6Y09e0 

FI=I  BE6Y0990 

F1M=I-1  BE6Y1000 

F12=2»I  BE6Y1010 

CEN0M=FI«<FI-FNU)»(FNU+FI2-2.C)  BE 6Y 1020 

GAM3=(FNL*F12)»(2.0«FNU»FIM)» (FND*F I M ) /OEN0W  BE6Y 1030 

GAM3=-GAV3«GAM2  BE6Y104C 

YNL  =  GAM2»ej<  12  )+YNL  BE6Y1050 

IF( AB  )  18, ie.20                                          '  BE6Y1060 

C  BE6Y1070 

C       KHEN  J(NL)IS  NEAR  ZERB  C0KPUTE  BY(2)FR0M  EQ. 18. ELSE  EQ17.            BE6YI080 

C  BE6Y1C90 
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le  E1=TXNL»GAK2  eE6YllOO 

BY{  2)=ei»ej(  12  )*eY(2)  BE6YIU0 

IF{KSTaP-K ) 19, 38.3e  8e6YII20 

19  El=( CAM2-GAM3) /?.0  BE6YII30 
BY(2)=El«e J( 12*1 )+aY(2)  BE6Y1140 

20  GA^'1=GAM^  BE6Y1150 

21  GAI>'2  =  GAM3  BE6YJ160 
C  BE6Y1170 

38     BY(l)=YNt  BE6Y1180 

1F(AB)23.23.22  BE6YtI90 

22  BYl 2 )  =  { YNU«BJ(KL  +  2)-2.0/(PI«X)  )/BJ(KL  +  n  8E6YI200 
C  BE6Y1210 

23  IF(N)31.24.25  BE6Y1220 

24  BESSL=eY(I)  BE6YI230 
G0  T0  29  Be6Y124C 

25  tF(N-l)2a.26.27  BE6Y1250 

26  6ESSL=8Y(2)  BE6YI260 
G0  T0  29  BE6Y1270 

27  00  26  1=1. Nl  BE6Y1280 
FH=I  BE6Y129C 

28     BYt  I+2)=C0NST» (FI  l*FNU)»By(I*l  )-8Y( I )  BE6Y1300 

BESSL=BY(NN*1 )  BE6Y13I0 

C  BE6Y1320 

29   BESeY=BESSL  BE6YI330 

3C  RETLRN  8E6Y134C 

C  BE6YI350 

21   IF{FNU-.50CO0 )  43.39.43  BE6Y1360 

12     6Y(  2  >  =  C0NST»FN(j»BY(  1  )-BY(2)  BE6Y1370 

BESSL=BY(2)  BE6Y138C 

IF(NN-l)2g.2g.32  BE6Y1390 

C  BE6Y1400 

32  FRAC=FNU  BE6Y14J0 
00  33  1=1. M  BE6Y1420 
FHAC=FRAC-1.0  BE6Y1430 

33  eY(  I*2)=C0NST«FRAC»8Y(  I* 1  )-8Y(  I  )  BE6Y144C 
C  Be6YI450 

BE6Y1460 
BE6YI470 
BE6YI480 
BE6Y1490 
BE6Y1500 
BE6Y1510 
BE6Y1S20 
BE6Y1530 
BE6Y1540 
BE6Y1550 
Be6Y1560 
BE6Y1570 
BE6Y1580 
BE6Y1590 
BE6Y 1600 
BE6Y1610 
BE6Y1620 
BE6Y1630 
8E6V164C 


BESSL=BY(NN*1 ) 

G0     T0     29 

!9 

BY(2)=BJ(KL+1 ) 

RESSL=BY( 2 ) 

IF     (NN-1 )     29,29.40 

lO 

ARG=-1 .0 

I2=KL+1 

C0     41         1=1. Nl 

12=12*1 

BY( 1+2 )=ARG»BJ ( 12 ) 

11 

ARG=-ARG 

EESSL=BY (NN* 1 ) 

G0     T0     29 

ERR0R     RETURN 

BESSL=0.0 

D0     37         I=1.I0IM 

;7 

BY(  I  )  =  0.0 

G0     T0     29 

END 

Identification:   BES4  -  Bessel  Functions  for  Complex 
Argument  and  Order 
FORTRAN  II  Coded  -  709^ 

Purpose:   To  compute  the  Bessel  functions 

Ja+n+ipf^^   ^^^  Ya+n+ip(^) 
where  z  =  a  +  lb  for  |z|  <  50,  O^a  <  1, 

and  |n|  =  0,1,2, ...,N. 

Restrictions:  Although  this  routine  has  been  used  In 

several  applications,  the  restrictions  on  the 
range  of  the  parameters  and  the  accuracy  of  the 
results  have  not  been  fully  determined.   For 
complex  argument  and  real  order  (p  =  0)  with 
ot  =  0,  n  =  0,1  and  |z|  <  10,  the  results  were 
accurate  to  5  or  6  significant  figures. 

Method:    The  method  Involves  computing  the  Bessel 
functions  J  (z)  for  one  argument  and  all 
orders  by  using  the  appropriate  recursion 
relationships  and  normalization  factors. 
Y^(z)  Is  calculated  by  summing  J  (z) .   See 
Goldstein,  M.  and  Thaler,  R.,  "Recurrence 
Techniques  for  the  Calculation  of  Bessel 
Functions"  MTAC,  Vol.  XIII,  No.  66,    April 
1939  • 

Usage:    The  routine  Is  entered  by  the  statement 

CALL  C0IffiES C A, B, ALPHA, BETA, N,BJRE,B JIM, 
YRE,YIM) 
where 

A         Is  the  real  part  of  the  argument 
B         Is  the  Imaginary  part  of  the  argument 
ALPHA     Is  the  real  part  of  the  order 
BETA      Is  the  Imaginary  part  of  the  order 
|n|+1     is  the  number  of  values  of  the 
functions  to  be  computed 
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BJRE      Is  a  one-dlmenslonal  array  where  the 
real  part  of  J  will  be  stored.   It 
must  have  a  dimension  greater  than 
or  equal  to  the  maximum  of  | z | +23 
and  |n|+15.   This  array  Is  also  used 
for  temporary  storage. 

BJIM      Is  a  one-dlmenslonal  array  where  the 
Imaginary  part  of  J  will  be  stored. 
The  dimension  requirement  for  BJEE 
also  applies  to  this  array. 

YRE       is  a  one-dlmenslonal  array  where  the 
real  part  of  Y  will  be  stored.   It 
must  have  a  dimension  greater  than 
or  equal  to  the  maximum  of  |n|+1 
and  3. 

YIM       is  a  one-dlmenslonal  array  where  the 
Imaginary  part  of  Y  will  be  stored. 
The  dimension  requirement  for  YRE 
also  applies  to  this  array. 
Results :   The  following  table  Indicates  the  values  contained 

in  the  array  BJRE  after  execution  of  the  routine. 

Similar  values,  as  Indicated  above,  are  found 

In  BJIM,  YRE,  and  YIM. 


N  >  0 


N  <  0 


BJRE(l)    Re  J^^^.p(A4-iB: 


Re  J  ,  „  ,  .^  (A+IB' 


BJRE (2)         Re   J   ^,_^.^(A+1B' 
a+l+ip 


Re   J      -,  ,.„(A+iB: 
a--L+ip 


BJRE(N+1)    Re   J   _^„..^(A+iB) 


Re   J 


a- 


N|+1(3 


(A+IB) 
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Notes:  The  routine  stores  the  values  of  J  and  Y  for 
each  call  to  the  routine.  This  routine  does 
not  use  FORTRAN  II  complex  arithmetic. 

Requirements : 

a)  Non-System  Subroutines 

L0GGAM   which  computes  the  natural 
logarithm  of  the  gamma  function  for  complex 
argument  is  used  by  the  routine.   Either 
version  of  the  routine  LGAM  listed  in  this 
report  satisfies  the  requirements   for 
this  routine . 

b)  System  Library  Functions  (closed  subroutines) 
ATAN,  C0S,  EXP,  L0G,  SIN,  SQRT 

c)  System  Built-in  Functions  (open  subroutines) 
ABS,  XABS,  XMAXO 

d)  Storage 

317^-1  Q  =  6l46o  locations  plus  the  required 

subroutines  listed  in  a)  and  b) 
Author:   M.  Goldstein 
Date:   September  I965 
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C0VPLEX  BeSSEL  FUNCTieNS 


leeS'iOl    C0MPLEX  HESSEL  FUNCTt0N  SLERaUTINE         PART   1   0F  16  382  CARDS  BESAOOIO 
THIS  ROUTINE  MAKES  N0  LSE  BF  FBRTRAK  CBVPLEX  ARITHMETIC  BES40020 

SUBR0UTINE  CKMBESC  X, Y, ALPt-A.BETA.N  .BJRE.BJIM.YRE. Y IM)  8ES40030 

DIMENSION  BJRE t  ICO  )  ,BJIM(  ICO)  .YHE (50)  .VIM (50)  BES40040 

CALL  STAHTIX, Y.N.K.R)  BES40050 

CALL  JPECLR ( X ,Y. ALPHA. BETA  ,K.fi ,BJRE ,BJIW)  BES40060 

CALL  JSLM(  ALPHA, BE  TA.K.BJRE.BJIM.SLMRA.SLIMIA  )  BES40070 

CALL  FACT0R( X.Y, ALPHA, SETA, C.R)  BES400eO 

CALL  JN0RV(K,Q,R,SUMRA,SLMA,ejRE  ,RJIM)  BES40090 

7  CALL  YSLM  ( X,Y , ALPHA. BETA  .K.BJRE ,E JIM, ASUMR.ASUMI )  BES40100 

8  CALL  YGNU  ( X,Y , ALPHA, BETA ,Q.R  .ASUMR,ASUMI  .BJRE.BJIM.YHE.Y IM>         BES40110 

9  CALL  WReNSK   ( X,Y,0 JRE,BJIM.YRE  ,YIM)  BES40120 

BJSQ=ejRE(l)««2+QJIM(l)««2  BE S4 0130 

IF(BJSQ-.C0CCCO05  )   14.14,15  BES40140 

14    CALL  YSUMP ( X.Y .ALPHA, BETA .K .BJRE.e JIM, ASUMR,ASLM1 )  BES40150 

CALL  YGNUP(X.Y, ALPHA, BETA, Q,R,ASUMR,ASLM1  ,8JRE,BJIM,YRE,Y1M)         BES40160 

15     IF  (N-l  )  10,  12.  11  8ES40170 

BES40180 
BeS40190 
BeS40200 
BES40210 
BES40220 
BES40230 
16  BES40240 

BES40250 
BES40260 
BES40270 
BES402a0 
BES40290 
BES40300 
BES40310 
BES40320 
BES40330 
16  BES40340 

BES40350 
BES40360 
BES40370 
BES40380 
BES40390 
BES40400 
BES404I0 
BES40420 

0H4I=1,K  BES40430 

L1=K+1-I  BES40440 

RALPHA=RALPHA- 1.0  BES40450 

A=((2.0«X»WALPHA)+(2.0«BETA«Y))/SSC  BES4C460 

B=((-2.0»Y»RALPHA)+(2.0»BETA«X))/SSO  BE S4 0470 

BJRE(Ll)  =  (A»ejRE(Ll+l))-(B»eJIM(Ll  +  l))-BJRE(Ll+2)  BE  34 0480 

4      BJ1M(L  1  )  =  (e»BJHE(L  1  +  1  )  )  +  ( A«B JIM(Ll  +  l  )  )-BJIM(Ll  +  2)  BES40490 

RtTLHN  BES40S00 

END  BES40510 

CBEb404    JSUM  SLERaLTINE  P«RT  4  0F   16  BES40520 

SUERaUTINt  JSLM( ALPHA, BETA  .K.EJRE  .PJI M.SLfRA.SUMI A )  BES40530 

DIMENSI0N  BJRE(  100)  ,OJIM(  ICO)  BES40540 


10 

IF  (N)  13.  12.  12 

13 

CALL  NEGN  (X.Y. ALPHA 

.BETA 

.N. 

.BJRE 

,e  JIM 

,YRE 

.YIM) 

G0  T0   12 

11  CALL  YHeCbR( X. Y.N.BJRE 

,BJ 

IM, 

pYRE,' 

r  IM) 

12 

RETLRN 

END 

:be' 

£402    START  SLBR0LTINE 
SUER0UTINE  START(X,Y 
SSG=X««2+Y««2 
KTEN=SQRTF(SS0)*20.0 
NTeN  =  XABSF (N  )♦  10 
M=XMAXOF(KTEN.NTEN) 
K=2«M+1 

R  =  K  ♦   1 
RETURN 
END 

.N 
/2 

,K, 

R) 

PART 

:□£ 

5403   JRECLR  SLeH0UTINE 

PART 

SUERauTINE  JRECUR(X, 

Y. 

ALP 

HA 

•  BETA 

,K  ,R, 

ejRE 

.BJIM) 

DIMENSI0N  BJRE( ICO ), 

BJ 

IM( 

ICO) 

RALPHA=R+ALPHA 

SSQ=X«»2tY«»2 

DJHE(K*2)=C 

ejIM(K*2)=C 

ejwE(K+l )=l.CE-37 

BJ  IM (K+  1  )=C.C 
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aOl    SUMRA=(BJRE( 3)»( ALPHA+2.0) )-(eJIH(3)«BET*)  8ES40550 

SUMIA=(HETA»BJrtE(3)  )♦(  ( ALPHA*2 . 0 ) 'B J  I K ( 3 )  )  BE S* 0560 

GRe=1.0  BES40570 

GIM=0  86540580 

5=1.0  86540590 

C06I=S.K.2  8ES40600 

S=S*1.0  BES40610 

GHEN=(  <GRE«{  ALPHA  +  S-1.0)  )-(BETA»GI>'))/S  BE  540620 

GIM=(  (  GIM«(ALPHA«S-1.0))'f  (BETA«GRE)  )/S  BES40630 

GRE=GREN  BE540640 

ALPTS=ALPHA+2.0»S  BE540650 

GJR=GRE»BJBE( I )  BE540660 

GJ I=GIM«BJIM( I )  BES40670 

GJRI=GRE«EJIh'(  I  )  BES40680 

GJ  lR  =  GIM«ejRE(  I )  BE540690 

SUMRB  =  ALPTS»tG  JR-GJI  )-BETA«(GJIR*GJRI  )*SU»»RA  B6S40700 

5UMIB  =  ALPIS»(GJIR*6JRI)-BETA«{GJ1-GJR)  +  S0>'IA  BES40710 

IF( ABSF( (SLMRB/SUMRAJ-l.O )-.0C0OOCO5)21.21.1O  86  54  0720 

21     IF(Sl>MIA  )2C,  1  1  .20  BE540730 

20     1F( AeSF(  (SUMIB/SCMIA )-l.0)-.0C000CC5)  I  l.l  I  .10  BES40740 

10     SUf«RA=SUMHe  BE540750 

6      SUMIA=StMI8  BE540760 

II  RETURN  BES40770 

END  8ES407eO 

PART  5  0F  16  BES40790 

>C.R)  BE54C800 

8ES40810 
BES40820 
BES40830 
BES4084C 
BE540a50 
BE540860 
DE540870 
BES40880 
85540890 
BES40900 
BES40910 
8ES40920 
BE540930 
BE540940 
B6540950 
8ES40960 
BES40970 
PART  6  0F  16  BES40980 

M  NEGATIVE  REAL  AXIS  BES40990 

BES4 1000 
BE  54 1010 
BES4  1020 
BES4 1030 
BES4  1040 
BES41050 
8E541C60 
BE541C70 
BES4 1080 
8E 541090 
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CBE 

S405   FACT0R  SUBRaUTINE 

SUBROUTINE  FACT0R( X.Y. ALPHA, BET; 

CALL  L0GGA>'(  ALPHA+l  .O.BETA.U.  V) 

CALL  C0N'L«C  t  X  ,  Y,  Al  .B  1  ) 

A2=ALPHA#Al-eeTA«Bl 

B2=EETA»A1+ALPHA«BI 

A2=-A2 

e2=-e2 

CALL  C0MEXP( AJ ,B2, A3,H3) 

A4=. 693147 ISCe* ALPHA 

B4=.e93ia718Ce«BETA 

CALL  CeN-EXPC  A4.Q4.A5.BS) 

A6=A3»A5-03»E5 

fi6=B3»A5+A3»e5 

CALL  C0MEXP(t . V. A7,B7) 

0=Ae«A7-Be«B7 

R=Be»A7+Ae«B7 

RETURN 

END 

CHE 

E406   C0ML0G  SLBR0UTINE 

C 

C0MPLEX  L0GARITHM  -  BRANCH  CtT 

SueR0UTINE  CKN'LBG  (  X,  Y.  A.B  ) 

PI  =  3.  1415926  =  4 

A=.5«L0GF(X»X+Y»Y) 

IF  (  X  )b.  1  .4 

1 

B=.e«Pi 

IF( Y)2,3.e 

2 

B  =  -e 

G0  T0  e 

3 

B  =  0. 

G0   T0   e 

0  =  A 

TAN 

IF 

G0 

T0 

8 

B  =  A 

TAN 

IF 

IF{ 

Y)e 

.■ 

B=e 

-PI 

G0 

T0 

e 

e=e 

♦  PI 

RET 

LRN 

t     -  C0MPLEX  BESSEL  FUKCTieNS  -  FBRTBAN  II  C0OEC 

BESAl 100 
8ES41 1 10 
BESAl 120 
BES41130 
BESAl 140 
BES4  11S0 
BES41160 
BES4I170 

EMC  BeS4JI80 

CBESA07   C0MexP  SUBR0UTINE                              PART  7     0F  16  BES41190 

SueR0tjTINE  CevexP(  X.Y.A.B)  BESAIZOO 

C=EXPF(X)  BES41210 

A=C»C0SF(Y)  BE341220 

B=C«SINF(Y)  BES41230 

RETLRN  BES41240 

tNC  BES4  12S0 

CBEtAOe    JN0RM  S(,BH0UTINE                                PART  8  0F  16  BES41260 

SUBR3UTINE  JNBRMIK.Q.R.SUf'RA.SUMIA.BJRE.BJIM)  BES41270 

DIMENSI0N  6JRE(  ICO.BJIMI  ICO)  BES412eO 

S=((SUMRA  +  BJRE(l))«0)-((Stf'IA*8JIM(l))»H)  BESAl  290 

T=((SUMIA  +  ejIM(l))«Q)*((SL»'RA«BJREll))»H)  BES4  1300 

IF(ABSF(S)-ABSF(T))100.101.101  BE S4 1310 

101  TS=T/S  8ES41320 
T3SQ  =  S«(  1  .C+(TS»»2)  )  BES41330 

12  D013I=1.K  BES4134C 
BJReN=(BJRe(I)+BJiy(I)»TS)/TSSC  BE S4 1350 
8JIV(I)  =  (BJII«(n-BJRE(I)«TS)/TSS0  BES4  1360 

13  BJRE( I )=BJREN  BES41370 
G0    T0    14  BES41380 

IOC    ST=S/T  BES41390 

STSC  =  T«(  (ST»»2  )  +  l .0)  BES41400 

10<:   O01C3I  =  1.K  BES41410 

BJ«eN=(BJRe(I)»ST*8JIM(I))/STS0  BE S4 1420 

BJIM(I)  =  (BJiy(I  )«ST-8JRE(  I  )  )/STSO  BES4  14  30 

102  BJRE(  I  )=BJREN  BES41440 
14  RETURN  BES41450 

END  BES41460 

CBES409   YSL,M  SIjER0UTINE                                 PART  <)  0F     16  BES41470 

SUER0UTINE  YEtNi  (  X.Y,  ALPHA  .BETA, K.EJRE  .BJIh'.ASLVR. ASUMI  )  BES41480 

CIMENSiaN  ejRE (  ICO  ).BJIM{  ICO)  86541490 

A  l  =  ALPt-A-l  .0  BESAISOO 

A2=A1-1.0  BESAISIO 

A3=A1*ALPFA  BES41520 

A4=eETA»«2  BES41530 

A5=2.0»AA  BES41540 

ABSQ=( -A  1  )«»2*AA  BES41S50 

GAMRE=((2.C*ALPHA)»{-Al)-AA)/*eSQ  8ESA1560 

GAMIM=(BETA»3.0)/AaSQ  BES41570 

ASU^'R  =  GAMRE•BJRe(3)-GAMIM•BJI^'(3)  BE  SA  1580 

ASUMI=GAMIV»8JRE(3)+GAVRE«8JIN(3>  BE SA 1590 

T=1.0  BES41600 

00  500  I=S.K.2  BES41610 

T=T+1.0  BES41620 

B1=2.0»T  BES41630 

Fl  =  ei  +  ALPI-A  BES4164C 
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BeS4  -  C0MPLEX  BESSEL  FUNCTieNS  -  FBRTRAN  II  CBDEO 

F2=A3+T  8ES41650 

F3=AI+T  BESAieeO 

F5=T-ALPHA  BES41670 

F6=A2+B1  8ES41680 

Gl=Fl«F2-AS  8ES41690 

G2=(F2+2.0«F1 )«BETA  BES41700 

hl=Gl«F3-e2«PETA  BE541710 

^-2  =  G^•F3♦Gl•BeTA  BES41720 

Pl=F5«Fe+A4  BES41730 

P2=(F5-F6)»BeTA  BES41740 

P3=Pl«»2+P2»«2  BES41750 

CRe=( {Hl»P:+h2«P2)/P3)/T  BE S4 17  60 

CIM=((H2»PI-Hl»P2)/P3)/T  BES41770 

TEMP  =  -(CRe«GAMf!E-C  IM«GAMIM)  8ES4  17eO 

GAMIM  =  -(CI»'«GAMRE  +  CRE»GAMiy  )  BES4  17  90 

GAMRe  =  TEK'P  BES4ie00 

8bUMR=GA^'RE•BJRe<l)-GA^«IM•8JIM(l)  ♦ASUH'R  8ES4  18  10 

BSUWI=GAMIV»BJRE(I  ) +GAMRe  "B  J  I  >»  (  I  j-fASU^I  BE  S4  1820 

IF(  AeSF<  (BSUN-R/ASUMRj-l.O-.OCOOOCCSjSZl  .52  1  .510  BES4  18  30 

52  1    IFC ASUMI  )520.S  11 ,520  BES4184C 

520    IF(ABSF( (BSUMI/ASUMI )-1.0>-. 00000005)511 ,511 .510  BES41850 

51C    ASUMR=BSUMR  BES41860 

50C    ASU»'I=BSUM  BES41870 

511   RETURN  BES41880 

END  8ES4  1890 

CBES4I0   VGNU  SUER0LTINE                                 PART  10  0F  16  8ES41900 
SUBRBUTINE  YGNU(X.Y.ALPHA.BETA.C.fi.AStMR,ASLM ,BJRE.8JIf.VRE,YlM)  BE S4 1910 

CIMENSI0N  BJRE( 100  )  ,BJIM(  ICO)  ,YRE (50)  .  Viy (50 )  8ES41920 

PI=3. 14 1592654  8ES41930 

TPI=2.0/PI  BE541940 

QRE=TPI«{0»«2-R«»2 )  BES41950 

GIM=TPI»2.C«Q»R  BES41960 

DRE=QRE»ASLMR-QIH«ASUMl  BES41970 

DIM=QIM«ASLMR*ORE»ASUMI  BES41980 

IF{ ALPHA ) 1.2. 1  BES41990 

2  IF{8ETA  )  1 , 3.  1  BES42000 

3  CALL  Y2ER0(  X.  Y  .ALPRE.  ALPI*/)  BES42010 
G0  T0  720  8ES42020 

1      PALPHA=P I'ALPHA                                              '  BES42030 

C0X=:C0SF  (PALPHA)  BES4204C 

SIX=SINF (PALPHA)  8ES42050 

EXY=EXPF(PI»eETA)  BES42060 

EXYl=1.0/hXY  8ES42070 

C0SI-  =  .5»(EXY  +  EXY1  )  8ES42080 

SlNt-=.5»(EXY-EXYl  )  BES42090 

CEN=(  S  IX»C0SI- )  ••2+(C0X»SINH)««2  BES42100 

ERE=( S IX«C0X )/DEN  BE542110 

E  IM= (-C0SH»SINH)/OEN  8ES42120 

ABSQ3=2.0»(ALPhA«»2+eETA»«2)  BES42130 

ALPRE  =  ERE-{(CRE''ALPHA  +  HETA«QIK)/AES03)  BES4  214C 

ALPIM=EIM-((QIM»ALPHA-BeTA«QRE)/AeSQ3)  BES42150 

72C   YHEC  1  )=ALPRE»B JRE (  1  )-ALPlK»B JIV (  1  )  tDRE  BES42160 

YlM(l)=ALPlM»BJRE(l)tALPRE«BJIW(l)+DIV  BE S4 21 70 

RETURN  BES42180 

ENC  BES42190 


BES4  -  C0MPLEX  BESSEL  FUhCTIBNS  -  FBRTRAN  II  CBOEO 

CBES41I    YZER0  SI.BB0CT1NE  PART  II  0F  16              86542200 

SueR0UTlNE  YZER0(X.Y.ALPRE.ALPIM)  BES42210 

TPI=2.0/3. l41592eS4  BES42220 

CALL  C0^'LeG(  X.  Y.A.8)  BES42230 

ALPRE=TP !•(-. 1 1593  15  157+A)  BE S4 2240 

ALPIM=TPI»e  86542250 

RETURN  BES42260 

END  8ES42270 

C8ES412   KR0NSK  SUBRBUTINE  PART  12  0F  16              BE542280 

SUBR0UTINE  »(R0NSK(  X.Y.BJRE.B  JIW.  YPE.YIW)  86542290 

O1MENSI0N  BJRE( 100).BJIM(  100)  .YRE(SO)  .YICCSO)  8ES42300 

SSQ=X»»2*Y«»2  8ES42310 

TP 1  =  2.0/3.  14 1592654  BE542320 

AZRE=TPI«X/SSQ  BES42330 

AZ IM=-TPI»Y/SSO  BE542340 

ZHE  =  BJRE{2)»YHE(  l)-BJIK(2)»YIf»{n  BES423S0 

ZIM=BJIM(2)«YRE( 1 )*BJRE(2)»YIK( 1 )  BES42360 

eZRE=ZRE-AZRE  8ES42370 

BZIM=ZIM-AZIM  86542380 

BJSQ  =  BJRE(  1)»«2*BJIM(  1  )»«2  8ES42390 

CZRE  =  BJRE(  1  )/BJSO  BES42400 

CZI»'=(-BJiy(  1  )  >/BJSQ  8ES42410 

YRE(2)=8ZRE«CZRE-BZIM»CZI»'  BE  54  24  20 

YIM(2)=BZIM»CZRE*8ZRE*CZII'  BE  54  24  30 

HETLHN  BES42440 

END  8ES42450 

CBES413   NEGN  SLERBUTINE  PART  13  0F  16              BES42460 

SUBR0UTINE  NEGN(X,Y. ALPHA. BETA. N,ejRE.BJI»'.YR6. VIM)  BE542470 

OIMENSI0N  8JRE( t00).BJIM(  ICO)  .VRE(EO)  .Vtf (50)  BE542480 

L=XAeSF(N)*l  86542490 

SS0=X«*2*Y<*2  BE542500 

TX=2.0«X  B6542510 

TY=2.0»Y  BE542520 

RALPHA=ALPhA  8E542530 

A=(TX»RALPhAtT Y»BETA  )/SSQ  BE54254C 

B=(-TY»RALPHA4TX«8ETA)/SSC  BE  54 2550 

BJRE(2)=A»BJRE(l)-e«8JIM<l)-BjRE(2)  BES42S60 

BJIM(2)=e«ejREt 1)*A»BJIM(1)-BJIM(2)  BE 54 25 70 

YRE( 2)  =  A»YRE(  1  )-8«VIM(  1  )-YRE(2)  BE  54 2580 

YIM(2)  =  B«YRE(  I  j^A^YIt'J  1)-Yiy<2)  8ES42590 

00  I   1=3. L  BE542600 

RALPHAsRALPt-A-l.C  BES42610 

A=(TX«RALPMA*TY»BETA)/SSO  BE  54 26 20 

B=<-TY»RALPHA*TX«BETA)/SSC  BE  54 2630 

BJHE(  I)=A»8JRe(I-l)-B»BJIK(I-l)-8JRE(I-2)  BE  54 2640 

BJII'(l>=B«ejRE(I-l)  +  A»BJIW(I-l)-BJIM(I-2)  BE  54  2650 

Y«E{I>=A»YRE(l-l)-B»YIM(l-l)-YRE(I-2)  BES42660 

1      YIM(  I)  =  B»YRE(  I-l  )+A*YlMt  I-n-Yly  (  1-2)  BE542670 

RETURN  86542680 

END  BE542690 

C8ES414   YRECUR  SUBRBUTINE  PART  14  0F  16              BE542700 

5UBR0UTINE  YH6CUR  (  X  ,  Y  ,  N  .  8  JRE  .8  J  I  M  ,  VRE  .  Y  I  ^' )  BES42710 

DI^'ENSI0N  6JRE{  100  )  .BJIM(  ICO)  .YRE  (SO)  .YI  V  (50)  BES42720 

SSQ=X»«2+Y«»2  BES42730 

TPI=2. 0/3. 141592654  8ES4274C 
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BeS4  -  CB^PLEX  BESSEL  FLKCTIBNS  -  FBRTRAK  II  CBOEO 

AZRE=TP1»X/SS0  eES42750 

AZIM=-TPI«Y/SSQ  BES42760 

L=N+1  86542770 

D0  1   1=3. L  8ES427eO 

ZRE=BJHE(I)»YRe(I-I)-BJIM(I)«VIM(I-n  86  542  790 

ZIM  =  BJIM(I)»YRe(l-l  j'fBJREd  >»>rIMtI-n  BE 54 2800 

BZRE=ZRE-AZRE  96542610 

BZIM=ZIM-AZIM  BES42820 

BJSG  =  BJRE(I-n»»2  +  BJIM(I-l)»«2  BE  54  28  30 

CZRE=8JRE( I-l )/BJSQ  BES42e4C 

CZ1W=(-BJI>'(  I- 1  )  )/BJSO  BES42eS0 

YRE(  I  )=BZRe»CZRE-BZI»'«CZIM  86  5428  60 

1  Y  IM(  I  )=BZ IM'CZRE  +  BZRE'CZiy  86542870 

RETURN  BES4288C 

END  BES42890 

C8ES415   YGNUP  SLBRBUTINE                                PART  15  0F  16  B6S42900 
SUERauTINE  YGNIjP(X  ,  Y  .  ALPHA  ,BE  T  A  .  Q  ,  R  ,  A  SUMR  ,  ASU  V  I  . 8J  RE.  BJIM.YRE.YIM)  BE  542910 

DIMENSI0N  BJRE (  ICO )  .BJIM(  ICO)  .YRE(£0)  .YIK(50)  BES42920 

PI=3. 141592654  BES42930 

TPI=2.0/PI  B6S42940 

QRe=TPI» (0«»2-R*«2 )  B6542950 

GIM=TPI»2.C»Q»R  B6S42960 

ORe  =  QRE«ASljMR-QIM»ASUMI  86542970 

CIM=QIM«ASLMR+QRE«ASUMI  BE542980 

IF( ALPHA) 1 .2, 1  BES42990 

2  IF(eeTA) 1. 3. 1  BES43000 

3  CALL  YZER0(X,Y,ALPRE.ALPIK)  BES43010 
G0  T0  720  86543020 

I      PALPHA=PI«ALPFA  BE543030 

C0X=C0SF(PALPHA)  BE54304C 

SIX=SINF(PALPhA)  86543050 

EXY=EXPF(P1«BETA)  8E543060 

EXY1=1.0/EXY  86S43070 

C0St-  =  .E«(EXY*EXYl  )  86543080 

SINH=.5»(EXY-EXY1 )  86543090 

CEN=(SIX»Cesi-)»»2  +  <C0X»5INH)»«2  86  54  3100 

ERE=(S IX»C0X )/DEN  B6S43110 

EIM=(-C0SH«SINH)/DEN  B6S43120 

AHS0  3  =  2.0»(ALPFA»«2*BETA»»2)  BE  54 3130 

ALPRE  =  ERE-((CRE»ALPHA  +  BETA*QIK)/AES03)  BE  543140 

ALPIM  =  EIM-((0IM»ALPHA-BETA«QRE)/AeSC3)  BE  54 3 150 

72C   TRe=ALPRE«BJRE (2)-ALPIM«BjIM(2 )+DfiE  BES43160 

TIM=ALPIM»BJRE(2)*ALPRE»BJIM{2)*0IK  86  543170 

ALPRE=-(Q«X+R«Y)/(X»»2+Y»»2)  86  543180 

ALPIM=-(X»W-0»Y)/(X«»2+Y»«2)  86  54  3190 

YRE(2)=ALPRE«BJRE(1)-ALPIK«HJ1C(1)*TRE  86  54  3200 

YIM(2)=ALPIM»BJRE(  1  )  +  ALPRE  "H  J  I  K  (  1  )  ♦TI*'  BE  54  32  10 

RETLRN  8E543220 

END  86543230 

C8ES416   YSUMP  SLBR0UTINE                                PART  16  0F  16  B6543240 

SUBR0UTINE  YSO MP (X.Y, ALPHA. BETA, K,BJRE.BJI»'.ASLVR.A5UM1)  86  543250 

DIMENSIBN  ejRE(  100  ).BJIM(  100)  BeS43260 

A1=ALPHA-1.0  BES43270 

A2=A1-1.0  86543280 

AJ=Al+ALPhA  8E543290 
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BES4  -  C0MPLEX  BESSEL  FUKCTIBNS  -  FBRTRAh 


'ABSC 


52  1 

52C 
51C 


50C 
5!  I 


A4=BETA«»2 

A5=2.0«A4 

ABSQ=(-Al)««2+A4 

R0LCRe=( (2.0+ALPHA)»(-A 

H0LCIM=(BETA«3.O)/ABSQ 

RES1=-H0LORE/'2.O 

VMS1=-R0LCIM/2.O 

ST0RE  =  3.«<  ALPI-A«X*6ETA»Y)/(X»«2*V««2) 

ST0IM=3.«( X»BETA-ALPHA»Y)/(X««2+V««2) 

ReS2=(R0LCRE»ST0RE-RBLOIM«ST0IM) 

VMS2=(R0LCRE»ST01M*ReLDIM»STaPE) 

ASUMR=RESl»BJRE(2)-VMSl«BJIM(2) 

ASUMR  =  ASUMR*RES2«BJRE(3)-V»'S2«BJIKt3) 

ASbMI=VMSl«BJRe(2)+RESl«BJlM(2) 

ASUMI  =  ASUKI*VMS2«BJRE(  3)<-BES2«ejI»'(3) 

T=1.0 

C0  500  I=3tK.2 

T=T+l.O 

ei=2.0»T 

Fl  =  Bl*ALPt-A 

F2=A3*T 

F3=AltT 

F5=T-ALPHA 

F6=A2+8l 

G1=F1«F2-A5 

G2=(F2+2.C«F1  )«BETA 

l-l  =  G  l«F3-G2»eETA 

H2=G2»F3*G1«BETA 

P1=F5»F6+A4 

P2=(FS-F6 )»BETA 

P3=P1««2*P2*«2 

CRE=( (Hl»Pl+h2»P2)/P3)/T 

CIM=:(  (I-2«P1-I-1»P2)/P3)/T 

TdMP  =  -<CRE«R0LDRE-CI»'»R0LCIM) 

RNEl»IM=-(CIM«R0LORE  +  CRE»ReLDIf) 

RNtli«Re  =  TEMP 

ReSl  =  (R0LDRE-RNE«iRE)/2.O 

VMS1=(R0LCIM-RNE»1M)/2.O 

RtS2  =  (RNE*RE»ST0RE-RNEl«IM«ST0Ilv) 

VMS2=(RNEI»HE«ST0IM  +  RNEV«IM«ST0BE) 

ei.U»'H  =  ReSl»BJRE(I*l)-VMSl«8JII'(I  +  l  )+AS(jMR 

BSUV1  =  VMSI«BJ«E(I  +  1)+HES1»BJI>'(I  +  1)+ASUMI 

8S>LIVR  =  RES2«BJRE(I*2)-VMS2»BJIK{I+2)*BSUMR 

BSUMI  =  VMS2»8JRE(I*2)+RES2«HJI>'(I*2)»BStMI 

1F(AB5F( (8SUVR/ASUMR)-l 

IF( ASUMI  )520.511 .520 

iF(AesF((esuMi/Asovn-i 

ASUMR=BSUMR 
ASUM I=6SLM I 
RBLC  tM  =  RNE*  Iff 
R0LCRE=RNE«|RE 
RETURN 
END 


0>-.OC 000005)521. 521. 510 
0)-.0C000CC5>51 1.51 1.510 


BES43300 
BES43310 
8ES43320 
BES43330 
BES43340 
BES43350 
BES43360 
BES43370 
BES433eO 
BES43390 
BES43400 
8ES43410 
BES43420 
BES43430 
BES43440 
BES434S0 
8ES43460 
BES43470 
BES43480 
BES43490 
BES43500 
BES43510 
BES43520 
BES43530 
aES43540 
BES43550 
BES43560 
BES43570 
BES43580 
BES43590 
BES43600 
BES43610 
BES43620 
BES43630 
BES43640 
BES43650 
BES43660 
BES43670 
BES43680 
BES43690 
BES43700 
BES43710 
BES43720 
BES43730 
BES4374C 
BES43750 
BES43760 
BES43770 
BES43780 
BES43790 
BES43800 
8ES43810 
BES43820 
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Identification:   BESSER  -  Bessel  Functions  for  Complex 

Argument  and  Order 
■  .      709^-PORTRAN  II  Coded  (uses 

FORTRAN  II  complex,  arithmetic) 
Purpose:    To  compute  the  Bessel  functions 
J^(z)   and  Y^(z) 

where  v  =  a  +  13  and  z  =  x  +  ly  for  0  <  a  <  1 . 

Restrictions :   0  j<  a  <  1. 

Accuracy:   A  thorough  check  has  only  been  made  for  v  =  0 
although  many  complex  values  of  v  have  been 
checked.   (The  accuracy  Is  best  when  the 
functional  values  are  largest.)   The  follow- 
ing results  are  typical  for  v  =  0. 
z=.086602540+.05l      J,Y  to  8 significant  figures 

z=2. 8284270+2. 82842701  J,Y  to  7 

z=6. 5639610+6. 56396101  J   to  7 

I     ■  Y  to  5 

z=:8. 6602540+5. 01       J   to  7 

Y  to  6 

Method:     The  values  of  the  functions  are  computed  from 
the  series  given  below. 

_     ^    (-1)^    (z/2)V+^^ 

^         ~    ho    k'r(v+k+i) 

Yq(z)    =  I   [J^(z){7+log(z/2)} 
00     f   -1  xk+1  „, 

+  y~  ^■-^'  ..    (z/2)2^  (1  +  1/2  +  ...+  i/k)] 
fci    (ki)^ 

where 

7  =  .57721  566...  (Euler's  constant). 
If  V  7^  0,  then 

cos(vTr)  J^(z)  -J  ^(z) 

^v^^)   =  sin  (vtt)  " • 

See  Table  of  Bessel  Functions  Jq(z)  and  J-,  (z) 
for  Complex  Arguments,  National  Bureau  of 

Standards,  1947 . 
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Usage:      Entry 

CALL  BESSER(Z,FNU,FJ,PY) 
where 

Z     Is  the  argument 
FNU   Is  the  order 
PJ    will  contain  the  value  of  J  (z) 

V 

FY    will  contain  the  value  of  Y  (z) 

V 

All  of  these  variables  are  assumed  to  be 
FORTRAN  II  complex  variables.   The  subroutine 
makes  use  of  FORTRAN  complex  arithmetic.   The 
values  of  both  J  and  Y  are  computed  for  each 
call  to  the  routine. 
Requirements : 

a)  Non-System  Subroutines 
L^GGAM 

This  is  a  subroutine  which  computes  the  natural 
logarithm  of  the  gamma  function  for  complex 
arguments.   Either  version  of  the  routine  LGAM 
listed  in  this  report  fulfills  the  requirements 
for  this  routine. 

b)  System  Library  Functions  (closed  subroutines) 
IC^S,  lEXP,  IL0G,  IS IN 

c)  System  Built-in  Functions  (open  subroutines) 
ABS 

d)  Storage 

853,  pi  =  15250  locations  plus  the  required 

subroutines  listed  in  a)  and  b). 
Authors:    Edith  Rohrmoser  and  Max  Goldstein 
Date:       January  I965 
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BESSEL  FUNCTI0NS  F0R  C0MFLex  eBOER  AND  ABGUKENT  -  FBRTR* 


SUBH0UTINE  BESSER( Z.FNU.FJ.FY)  BESROOIO 

CIMENSIBN  A(l),TE(l).FK(l).TERV(l).FN(j(n.Z(l).FJ(l).FV(l)  BE  SR  0020 

DIMENSmN  TENEW(  I  )  .ABLDI  I  )  ,ATe»«P(  I  )  ,ANE*»(  n  BESR0030 

OIMENSI0N  SUMULDl  1  )  .SUTEMPC 1  )  ,StMNE*(  1  )  8ESR004C 

PI=( 3. I41592e5.0. )  BESR0050 

EPS=l.E-Oe  BESR006C 

GAVMA=( .57721566.0. )  BESR0070 

Z2=Z/(2.,0.)  BESROOeC 

1F(FNU)3.^,3  BESRCC9C 

3  CALL  BES JJ(FNU.Z.F J.TERM)  BESROIOC 

CALL  HESJJ(-FNU.Z.GJ,TERH)  BESROllO 

PW0C=FNU»PI  BESR0120 

FY=(C0SF(PR0D)»FJ-GJ)/SINF(PReD)  BE SR 0130 

RLruRN  BESROIAC 

It     TE0LD=(  1  .0,0.  )  BESRC150 

A0LC=Z2»»2  BESROieO 

SUMIZLC  =  A0LD  BESH0170 

K=2  BESROieC 

e  FK(  n=K  BE5R0  190 

FK ( 2  )  =0.  8ESRC200 

GL  IEO=(  1 . ,0.  )/FK  BESR0210 

TENew=TE0LO+GLIEO  8ESRC220 

ANEW=-Z2«»2»TENE»«A0LD/(FK««2«TE0LO)  BE SR 0  2 30 

SUMNE\•  =  SU^'^LC  +  ANE^»  BESR024C 

SUTEMP=SUM0LO  BESR0250 

K=K+1  BESRC26C 

TE0Ln=TENen  BESRC27C 

A0LC=ANE*  BESR028C 

SUMeLD=StMNE»  BESR02qC 

IF( SUTEMP(  1  )  )5.2.5  BESH030C 

2  IF(K-3)e.6.7  BESRO3I0 

5  RAT  I01=SLN"NE»(  1  )/SUTEMP(  1)  BESR0320 

IF(A8SF(HATI01-1.)-EPS)7.7.6  BESR0330 

7  IF(  SUTEMPI 2  )  )e.9,e  BESH030C 
9  IF(K-3  )e .6  .  10  BESR0350 

8  RAT  I02  =  SUVNEI»(  2)/SUTEMP(  2)  BESR0360 
IF(ABSF(RATI02-l.)-EPS)lO,lO,e  BESR0370 

10  CALL  BES JJ(FNL ,Z,F J.TERM)  BESR038C 

I       FY=(2. ,0. )/PI • (F J» (GAMMA+L0GF (Z2 ) l+SUKNEW )  BESR0390 

RETLRN  BESROAOO 

END  BESRO-JIO 

SUeR0UTlNt  8ESJJ(FNL  .Z ,F J.TERK )  BESR0A20 

I       DIMENSI0N  FNL(  1  )  ,FK(  1  )  .RATie (  1  )  ,Z2( 1 )  ,U(  n  .SUy(  1  )  ,SUM0L(  1  )  BESR0A30 

EPS=1.E-Ce  BESROAAC 

C       Ta  C0MPUTE  FIRST  TERM  BESR0A50 

K=0  BESHOAeC 

I       Z2=Z/(2..C.)  BESR0A70 

CALL  L0GGAM(FNU(  1  )  ♦!.  ,FNLI{2)  ,(.  (  1  )  .t  (2)  )  BESR048C 

I       G  =  l-.XPF(U)  BESR0A90 

I       ETEHM=EXPF(FNL»L0GF( Z2) )/G  BESRC50C 

I       TERM=(1..0.)  8ESR0510 

I       SUMiTERM  HESRC520 

2  FK(  1  )=K  BESRC530 

FK(2)=0.  BESRC5AC 


BESSER  -  BESSEL  FbNCTI0NS  F0R  C0^FLEX  eRDER  AND  ARGUMENT  -  F0BTRAN  II  C0DED 


T0  C0MPUTE 
TtH!M=-TEHM« 
SUM0L=SOM 
SUM=SUM+TER 


THE  0THER  term: 
Z2«»2/(  (FKK  I  . 


CALCULATING  THEIR  SUC 
MFNL  +  FK*(  1  .  .0.  )  )  ) 


IF(  SUM0L(  1  )  )3.4.3 
3  RAT  10(1  )=SLM(  1  )/SUN 


3L(  1  ) 
)-EPS)'>  , 


IF( ABSF(RATI0( I ) 

IF( SUW0L(2 ) )e.7,5 

IF(SUM(2 ))2,e,2 

RATI?!(2)=SLM(2)/SLM0L(2) 

IF(ABSF(RATI0(2)-l.)-EPS)e 

FJ  =  SLiM»ETERM 

RtTURN 

END 


BESHC550 
BESR0560 
BESRC570 
BESROSeO 
BESR0590 
BESR0600 
BESROeiO 
BESR0620 
BESR0630 
BESR064C 
BESR0650 
BESROeeO 
BESR0e70 

BESRoeec 

BESRCe90 
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Identification: 


BESASY  -  Asymptotic  Bessel  Functions 

for  Complex  Argument  and  Order 
7094-FORTRAN  II  Coded  (uses 
FORTRAN  II  Complex  Arithmetic) 
Purpose:    To  compute  the  Bessel  functions 
J  (z)   and  Y  (z) 
where  v  =  a  +  ip>  and  z  =  x  +  iy  for  large  z . 
Restrictions :   z  should  be  large,  y  <  88. 


Accuracy:   A  thorough  check  has  only  been  made  for 

V  =  0  although  many  complex  values  of  v  have 
been  checked.   (The  accuracy  is  best  when  the 
functional  values  are  large.)   The  following 
results  are  typical  for  v  =  0.   (When  z  is 
pure  Imaginary,  the  functional  values  which 
are  small  do  not  have  too  many  significant 
figures . ) 

z=6. 5639610+6. 56596101  J,Y  to  7  significant  figures 
^=7  "0710678+7. 07106781  J,Y  to  6      ■'         " 
z=8. 66025588+5. 01      J,Y  to  6      "         " 
z=25.0  J,Y  to  8 


Method:    The  values  of  the  functions  are  computed  from 
the  asymptotic  series  given  below. 

J^(z)   =  y^  [P^(z)cos[z-  |(2v+l)] 
-  Q^(z)sln[z-  |(2v+l)]} 
y/^  [P^(z)sln[z-  ^(2v+l)] 
-  Q  (z)cos[z-  ^(2v+l)]] 


Y^(z) 


where 


P,(z) 


Q,(z) 


1  + 


00 
k=l 


^  (-l)^-(4v^-l^)(4vg-5^) 
k=l 


(2k; 

2^,,,   2 


^Fir^2k- 


(4v^-[4k-l}^) 


,  .  ^k+1  (J4v^-l^)(4v-^-5")...(4v^-f4k-5]^) 
^^^  (2k-l)i  2^^-5  z^^-^ 
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and 

I  arg  z  I  <     IT 
See  Table  of  Bessel  Functions  J^(z)  and  J.(z) 
for  Complex  Arguments,  National  Bureau  of 
Standards,  1947. 

Usage:      Entry 

CALL  BESASY(Z,FNU,PJ,Fy) 
v;here 

Z    is  the  argument 
PNU   Is  tne  order 

PJ   vjlll  contain  the  value  of  J  (z) 
FY   will  contain  the  value  of  Y  (z) 
All  of  these  variables  are  ass-omed  to  be 
FORTRAN  II  complex  variables.   The  subroutine 
makes  use  of  FORTRAN  complex  and  double 
precision  arithmetic.   The  values  of  both 
J  and  Y  are  computed  for  each  call  to  the 
routine. 

Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
DCS^S,  DEXP,  DSIN,  ISQRT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS 

c)  Storage 

1054   =  20560  locations  plus  the  required 
subroutines  listed  in  a). 
Authors :    Edith  Roh27moser  and  r4ax  Goldstein 
Date:      January  19^5 


.60 


ATeRM  =  -(  (ft  ..c. 

)<F 

NU 

••2 

-<  1.  ,0. 

>  )• 

(  (4..0. )• 

FNU 

(  (  126. .0.  )«Z«» 

2) 

PSOM=t  1  .  .C  .  )  tA 

TER 

M 

Fl ( 1 )=I 

FI (2)=0. 

PSUM0=PSUM 

ATtRM=-ATERM» ( 

(4. 

.0.  ) 

»FNU 

••2- 

-(  (4 

.  .0 

.  )«FI  +  (  1. 

.0. 

•(  <4.  .0.  )»FNL* 

•2- 

(  (4. 

.0.) 

»FI+(3. 

.c. 

) )««2)/(2 

••2 

(  ( 2. .0. ) "F  It (  1 

.  .0 

.  )  )• 

(  (2. 

.C. 

•Ft 

♦  <2 

.  ,0.)  )  ) 

PSL^'  =  PSU^'  +  ATEH 

M 

r  -  ASYVPTBTIC  seSSEL  FUNCTI0NS  F0B  CB^'FLEX  0ROER.  ARGUMENT  -  F0RTRAN  II 

SUERauTlNE  HESASV( 2.FNU.FJ.FV )  8SAYC010 

DIMtNSI^N  ARG(l).Z(l).FJ(l».F>(l),FPI(l).FNU(l>,PF0UR(l),FI(n  BSAYC02C 

DIMFNSI0N  ATERM( 1 ) .PSLN (l).PSUKe(l).8TERM(l),GSUM0(l)  RSAY0030 

DINfENSieN  GS1.^'(  1  )  .  YSIN(  J)  ,YC0S  (I  )  BSAY004C 

r;iMeNsi0N  r(1),xi(1)  bsayooso 

CIMENSI0N  SQ(U  BSAY006C 

OIMENSI0N  TeNP(4)  BSAY0070 

C0NS=.39ft9422e  BSAYOOBC 

SQ=SQRTF(Z)  HSAYCCSO 

PPI=( 3. 141592e5t0. )  BSAYOICC 

PFHLR=( .7853961635.0. )  BSAYOllO 

ePS=l.E-C6  BSAY0120 

1=1  flSAY0130 

•2-(9..0.))/  BSAY014C 
eSAYOlSO 
BSAYOieO 
BSAY0170 
BSAYOieC 
BSAY0190 
?)  BSAY0200 

.0.)««fc«  BSAY0210 

BSAY0220 
BSAY023C 

1=1+1  BSAY024C 

IF( 1-10)20.20,6  BSAY0250 

IF(PSUM0( 1 ) )g,a.9  BSAY0260 

PRAT 1=P5UM( 1 )/PSLM0( 1 )  BSAY0270 

IF(ABSF(PRATl-l.)-EPS)a.2.2  BSAY02eC 

IF <PSUM0(2 ) )3.  6.3  BSAY0290 

PHAT2=PSLM(2)/PSUM0{2)  BSAY03CC 

IF(ABSF(PRAT2-1.)-EPS)6.2.2  RSAY0310 

1=1  BSAY0320 

eTERM=(  ( 4.  ,0.  )«FNU     ••2-( 1. .C.  )  )/(  (8.  .0.  )*Z)  BSAY0330 

OSUM=nTERM  BSAY034C 

FI ( 1 )= I  BSAY0350 

F  I  ( 2  )=C.  BSAY03eO 

USUA'0  =  GSUM  BSAY037C 

HTERM=-HTeRM»(((4..0.)»FNt»»2-((4..0.)«FI-(l.,0.))»«2)»  BS AY 0360 

(((4.,0.)»FNU«»2-((4..0.)»FI+(1..0.))««2))/(Z«»2«(2.,0.)»»7»  BSAY0390 

lFI»(t2..0.)»FI+(1..0.)))  BSAY0400 

Q3UV=0SUM+BTERM  BSAY0410 

1=1+1  BS4Y042C 

IF( 1-10)21 .21 .7  BSAY0430 

IF(OSU^'0(  1  )  )  1  1  ,  12.  1  1  BSAY044C 

QWAT I=OSUf ( 1 )/QStM0( 1)  BSAYO4S0 

IF(4BSF(0HATl-l.)- EPS) 12,4,4  BSAY046C 

IF(QSbW0(2 ) )S.7,5  BSAY0470 

0HAT2  =  QSU^' (2  )/QSl,M0(  2  )  flSAY046C 

IF(AfiSF(QRAT2-l.)-EPS)7.4,4  BSAY049C 

AHG=(Z-((2..0.)»FNU+(1..0.)  )«FFetlfi)  BS  AY  05  0  0 

THE  F0LL0*ING  STATEVENTS  CeMPLTE  THE  SINE  ANC  C0SINE   IN  OeUBLEPRECBS A YO 5 1 0 
ANH  F0R  C0MPLEX  ARG  RSAY0520 

R(  I  )=ARG<  I  )  BSAY0530 

X  I  (  1  )  =  flRG( 2  )  BSAYC54C 

R(?)=0.  BSAYC550 
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QESASY  -  ASYWPT0TIC  aesseu  funci 


F0S  C0VPLEX  0RDER.  ARGUMEt 


FeRTRAN  I 


XI ( 2 )=0. 
XSIN  =  SINF(,-?) 
XCt'S=C«SF(R) 

exi:exPF(xi ) 
exi2=( i.o/ext )»»2 
cnNST=(c«'NS»exi  )/(so(i 

A=PSUM(2  )-QSl.M(  1  ) 
8=-PSUM( I )-QSLM(2) 
C=PSO^  12  )  ♦QStl'C  1  ) 
0  =  PSuy{   1  )-QSLM(2) 
AT=A 


OH  50  J= 1 .2 

/HA=-B*XCHS*A»X3IN 

eB=C»XC0S-C«XSIN 

CC=A«XC0S+B«XSIN 

CD=C»XC0S+C»XSIN 

T£IVP(  2J-  I  )=C0NST»t  (AA«SQ(  : 

TtMP(2J)=C0NST»((CC«SQ<l)- 

A=-eT 


)»«2*SC(2) 


)+CC»SC{2) ) 
AA»<C(2) )*e: 


EXI2«(eB»SC(l  )+00«SC(2  )  )  ) 
I2«(DC«SC( I )-Be»SC{ 2) ) ) 


C  =  -CT 

C  =  CT 

FJ(  1  )  =  TEMP(  1  ) 

FJ(2  )  =  TEMP( 2) 

FY(  1  )  =  TEMP{3) 

FY( 2)=TeMP(4 ) 


REl 


^RN 


;NC 


flSAYC560 
BSAYC570 
OSAYCSeC 
BSAYC^qC 

BSAYoeoc 

BSAYC6 10 
BSAYCe20 
BSAY0e30 
RSAY064C 
BSAYCeSO 

BSAYceeo 

BSAYOe70 

HSAYOeec 

BSAY0e9C 
BSAY0700 
BSAV07IO 
BSAY0720 
BSAY0730 
BSAY074C 
eSAY0750 
BSAY0760 
BSAY077C 
BSAYO/eC 
BSAY07gC 

BSAYoeoc 

BSAYCeiC 
BSAY0e20 
BSAYOejC 
BSAY0P4C 
BSAYOeSO 

BSAYceec 
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Gamma  Function 

1.  GAMMA    Incomplete  Gamma  Function  -  FAP  Coded 

2.  LGAMl   Log  of  the  Gamma  Function  for  Complex 

Argument  -  FAP  Coded 

3.  LGAM2   Log  of  the  Gamma  Function  for  Complex 

Argument  -  FORTRAN  Coded 
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Identification:   GAMFxA  -  Incomplete  Gamma  Function 

7094  -  FAP  Coded 
Purpose:   This  routine  evaluates  the  Incomplete  gamma 
function  00 

r  Ca,x)  =  f  e'"^   u^-^  du  . 

X 

Method:    One  of  three  different  methods  Is  used  depending 
upon  the  values  of  the  arguments. 
Method  A:   If  one  of  the  following  three  sets 
of  conditions  holds  then 

r  (a,x)  =  r  ta)  -  S^  [1  +  ufl  +  (a-auLg)^-' 

(1)  0  ^  X  _<  1,   |a|  >  0,   a  not  a  negative  Integer 

(2)  .l_<x<l,  |a|^l,   a  not  a  negative  Integer 

(3)  a  >  0,   x/a  <  1. 

Method  B:   If  one  of  the  following  two  sets  of 
conditions  holds  then 

r  (a,x)  =  (-l)'^  [E  (x)  -  e-^IZ  M)""-^! 

where 

n         =  -a 

m=l 
7  =      .57721    566...       (Euler's    constant) 

(1)  0<x<l,      a  =   0 

(2)  0  <  X  <  1,   a   Is  a  negative  Integer. 

Method  C:   If  one  of  the  following  three  sets 
of  conditions  holds  then 


r  (a,x) 


^  1-a 

X  H 

1  + 


2-a 
1  + 
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(1) 

a  <  0,   X  >  1 

(2) 

a  >  0,   x/a  >   1 

C3) 

|a|  <  1,   .1  ^  : 

Restrictions: 

The  routine  shoi 

X     <     1 


following  situations: 

(1)  X  <  0 

(2)  X  =  0,   a  =  0 

(3)  X  =  0,   a   is  a  negative  integer. 

There  are  situations  in  which  values  of  a  and 

X  will  lead  to  an  overflow  condition,  e.g. 

a -In  X  >  88.028.   These  situations,  however, 

are  not  rigorously  defined. 
Usage:     The  routine  is  a  PAP-coded  function  for  use  in 

a  FORTRAN  routine.   For  example, 
Y  =  GAMMAF(A,X) 

where  A  is  the  exponent  and  X  is  the  lower 

limit  of  integration  (see  the  definition  given 

above) . 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
L0G,  EXP 

b)  Storage 

575-1 Q  =  5670  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:    M.  Goldstein  and  P.  Ragusa 
Date:   July  1964 
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tNC0MPLETe  GAKI»*  FLKCTIBN  -  FAP  C0DED 


709-*  NYU 

I  -  R0UTINE 

N0  STANDARD  EHRBR 

FAP 

094  NYU 

I  -  R0UTINE 

PCC 

C0UNT 

367 

LfiU 

GAvy .e00M 

TTL 

INCeMPLETE 

REy 

CALL  ING  SE 

HEM 

Tt-tS  PR0GRA 

ENTRY 

GAMMA 

I  SXD 

X4  .4 

5*C 

X2.2 

SXC 

X  1.  1 

STC 

Y 

JENCE  Z     =  GAMMAF(A.X) 

C0NTAINS  FOH'S. 


TSX 

SUB. 4 

PZE 

0 

PZE 

17 

HNC 

PCX 

O.l.O 

PDX 

0.2.0 

ALS 

19 
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e 
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TEMP 
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TEMPI 
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TEMP2 

STC 

TEMP3 
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TEMP3 

FAC 

Al 

ST0 

TEMP2 

CLA 

TEMPI 

Fse 

A 

FDF 

TEMP2 

STC 

TEMPJ 

CLA 

TEMP3 

FAC 

Y 

STB 

TEMP2 

T  IX 

FXPl*  I.  1.  1 

CLA 

A  1 

FCt- 

TEMP2 

STC 

TEMP2 

CLA 

Y 

TSX 

*L0G.4 

STB 

TEMP3 

LCO 

TEMP3 

FyP 

A 

Fse 

Y 

TSX 

tEXF.4 

sTe 

TEMP3 

LCG 

TEMP3 

FMP 

TEMP2 

LXC 

S\/4.4 

TSA 

1  .4 
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233000000000 

GAI- 

'M0550 

GAM 

IM0560 

GAM 

'M0570 

GAM 

IM0580 

GAM 

IM0590 

GAM 

'M0600 

GAM 

'M0610 

GAM 

IM0620 

GAM 

'M0630 

GAM 

IM0640 

GAM 

IM0650 

GAM 

•M0660 

GAMM0670 

GAMM0680 

GAV 

IM0690 

GAM 

M0700 

GAMM0710 

GAM 

M0720 

GAM 

MO730 

GAM 

M0740 

GAM 

M0750 

GAM 

M0760 

GAM 

M0770 

GAM 

M0780 

GAM 

M0790 

GAMMOeOO 

GAMMCeiO 

GA»' 

M0820 

GAM 

yoa30 

GAM 

Moa4C 

GAM 

Moaso 

GAM 

M0860 

GAM 

M0870 

GAM 

Moeao 

GAM 

M0890 

GAW 

M0900 

GAMM0910 

GAV 

M0920 

GAM 

M0930 

GAM 

M094C 

GAM 

M0950 

GAM 

M0960 

GAM 

MC970 

GAM 

M0980 

GAM 

M0990 

GAM 

MICOO 

GAM 

MICIO 

GAM 

M  1020 

GAM 

M  1030 

GAM 

M104C 

GAM 

M1C50 

GAM 

M1C60 

GAM 

M  1070 

GAM 

M  1080 

GAV 

V1C90 
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CL* 

TEMPI 

Fse 

A  1 

ST0 

TEMPI 

TR/> 

L0P 

SXO 

SAVEA .4 

STZ 

I-0LD 

CLS 

Al 

ST0 

ST0RE 

CLA 

A  1 

STB 

STBRE*1 

ST0 

ST0RE+2 

STB 

ST0RE+3 

CLA 

SVA+l 

FAC 

Al 

ST0 

ST0RE+4 

CLA 

Y 

ST0 

STBRE+S 

LCG 

5T0RE+5 

FMP 

ST0RE*3 

STB 

ST0RE+3 

LCC 

ST0RE+2 

FMP 

ST0RE*! 

STB 

ST0RE*l 

CLA 

ST0RE»3 

FCh 

ST0RE*! 

FMP 

ST0RE 

FDh 

ST0RE+A 

STC 

ST0RE46 

CLA 

ST0RE*6 

FAC 

e-BLC 

STB 

HeLC 

CLA 

ST0RE+6 

SSP 

SUB 

F  I 

TMI 

0LT 

CLA 

ST0RE+2 

FAC 

A  1 

STB 

ST0RE+2 

CLS 

STBRE 

STB 

ST0BE 

CLA 

STBREtA 

FAC 

A  1 

STB 

STBRE*4 

TRA 

GB 

LXC 

SAVE4.4 

TRA 

1  .4 

SXC 

SX4  ,4 

CLA 

A  1 

FDH 

Y 

STG 

T0 

STO 

TB*1 

STG 

T4 

CLA 

A  1 

GAMMI 100 
GAMMIUO 
GAMMI 120 
GAMMI 130 
GAMMI 140 
GAMMUSO 
GAMM1160 
GAMM1170 
GAMMI 180 
GAMMI 190 
GAMM1200 
GAMM1210 
GAMM1220 
GAMM1230 
GAMM1240 
GAMMI250 
GAMM1260 
GAMM1270 
GAMM1280 
GAMM1290 
GAMM1300 
GAMM1310 
GAMM1320 
GAMM1330 
GAMM1340 
GAMM1350 
GAMM1360 
GAMM1370 
GAMMI3eO 
GAMM1390 
GAMM1400 
GAMMI410 
GAMM1420 
GAMM1430 
GAMM1440 
GAMM14S0 
GAMM1460 
GAMM1470 
GAMMlAaO 
GAMM1490 
GAMM1500 
GAMMISIO 
GAMM1S20 
GAMMI530 
GAMM1S40 
GAMMISSO 
GAMM1560 
GAMMI570 
GAMMlSeO 
GAMM1S90 
GAMM1600 
GAMM1610 
GAMMt620 
GAMM1630 
GAMM1640 
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STZ 
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SVA+1 
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CLA 

A  1 
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Y 
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tL^IG, 

FAC 
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CHS 
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GAMM2150 
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GAMM2190 
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rzE 

0LT1 

TSX 

0LT*2.4 

CLS 

Y 

TSX 

$exp.4 

STW 

TEMPJ 

LCQ 

TEMP3 

FMP 

TO 

CHS 
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KEEP 

ST0 

T5 
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CLS 

Al 
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ReSS2*l 
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ST0 
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FMP 

KEEP+3 

3TH 

KeEP+3 

TPA 
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TS 
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GAMM2370 
GAMM2380 
GAMM2390 
GAyM2400 
GAVM24 1 0 
GAMM2420 
GAMM2430 
GAMM2440 
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GAMM3430 

GAMM344C 

GAMM34S0 

GAMM3460 

GAMM3470 

GAMM3480 

GAMM3490 

GAMM3500 

GAMM35I0 

GAMM3520 

GAMM3530 

GAMM3e4C 

GAyM3550 

GAMM3560 

GAyM3570 

GAMM35eO 

GAMM35qO 

GAMM3600 

GAMM3610 

GAyM3620 

GAMM3630 

GAMM364C 

GAMM36S0 

GAMM3e60 

GAMM3670 

GAMM3680 

GAMM3690 

GAWM3700 

GAMM3710 

GAMM3720 

GAMM3730 

GAMM3740 

GAfM3750 

GAMM3760 

GAMM3770 

GAMM37eO 

GAMM3790 

GAMM3800 

GA^'M3elO 

GAMM3820 

GAh'M3830 

GA^'M384C 
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Identification:   LGAMl  -  Log  of  the  Gamma  Function  for 

Complex  Argument 
PAP  Coded  -  709O 
Purpose:   To  compute 

U  =  Re  in  r  (x  +  ly) 
and 

V  =  Im  In  P  (x  +  ly) 
where  x  and  y  are  normalized  floating  point 
numbers . 
Restrictions:   a)  x  and  y  may  not  both  be  equal  to  zero 
b)  If  y  =  0,  X  may  not  be  equal  to  a  negative 
Integer . 
Method:  a)  In  P(z)  =  -  z  +  (z  -  -|)  In  z  +  Iny^  +   J(z) 
where  J(z)  Is  given  as  a  continuous  fraction. 
See  Wall,  "Analytic  Theory  of  Continued  Functions/ 
p.  364,  formula  93.9  and  z  =  x  +  ly . 

b)  For  X  <  2,  In  ]  (z)  is  computed  from  the  recursion 
relation: 

In  r(z)  =  In  r(l+z)  -  In  z 

c)  For  negative  x,    the  Im  In  "[""(x+iy)  can  be 
thought  of  as  being  equal  to  V+27rk:,  where  k 
is  an  Integer  and  V  is  given  by  this  routine. 

d)  For  a  complete  bibliography  and  a  12-declmal 
table  of  U  and  V  for  x,y  =  0  (.1)  10,  see 
National  Bureau  of  Standards,  Applied  Math. 
Series  J)k ,    Government  Printing  Office. 

Usage:     With  X  and  Y  defined,  use  the  FORTRAN  statement 
(or  the  FAP  equivalent) 

CALL   L0GGAM(X,Y,U,V) 
and  control  will  return  with  U  and  V. 
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Accuracy:  In  general,  the  minimum  accuracy  is  a  few 
units  in  the  seventh  significant  digit. 
The  accuracy  is  somewhat  less  where  the 
function  value  is  small  in  absolute  value. 

Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
ATAN,  L0G 

b)  Storage 

210-,p|  =  522o  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:    M.  Goldstein 
Date:     December  I962 
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»  FAP 

LBL  NtiLGAM.X 

•NULGAMOl 

C0UNT  210 

ENTRY  L0GGAM 

L0GCAM     SXD  X4,0 

A07<;2    CLA»  1  .4 

STB    A0793.0 

STB  A079A,0 
A07g5  CLA«      2,4 

ST0  A0796.0 

CLA  0003. A 

STA  A0797.0 

CLA  0004,4 

STA  A0798.0 

ST2  B0791.0 

STZ  B0792.0 
C0797  CLA       A0793 

TZE       B0793.0 

TMI  B0794.0 

CLA       A079e.O 

FDH  A0793.0 

STQ  C0MM0N*OOOO.O 

CLA  C0MM0N*OOOO.O 

TSX       SATAN, 4 
ST0  B0796,0 

LDQ  A0793.0 

FMP  A0793,0 
ST0  C0MM0N+OOOO.O 
E0793  LDQ  A0796,0 

FMP  A0796.0 
FAC  C0MM0N+OOOO,O 
ST0  B0797,0 
TSX  «L0G,4 
FDH  C0792,0 
STO  C0MM0N+OOOJ ,0 
CLA  A07g3,0 
FSB  C0792,0 
TPL  C0793.0 
CLA  B079e.O 
FAD  B079l,0 
ST0  B0791,0 
CLA  C0MM0N^OOO1 ,0 
FAD  B0792.0 
ST0  80792,0 
CLA  A0793,0 
FAD  C0794.0 
ST0  A0793,0 
CLA  C0795.0 
STA  C0796,0 
TRA  C0797,0 
C0793  CLA  A0793.0 
FSB  C0798.0 
ST0  C0MM0N+OOO2.O 


(SO  PL   YSQ 


LGAMOOIO 
LGAMC020 
LGAM0030 
LGAM004C 
LGAM0050 
LGAM0060 
LGAM0070 
LGAM0080 
LGAM0G90 
LGAMOIOO 
LGAMOUO 
LGAM0120 
LGAM0t30 
LGAM0140 
LGAMOISO 
LGAM0160 
LGAM0170 
LGAMOieO 
LGAM0190 
LGAM0200 
LGAM0210 
LGAM0220 
LGAM0230 
L6AM0240 
LGAM02S0 
LGAM0260 
LGAM0270 
LGAM0280 
LGAM0290 
LGAM0300 
LGAM0310 
LGAM0320 
LGAM0330 
LGAM034C 
LGAM0350 
LGAM0360 
LGAM0370 
LGAM0380 
LGAM0390 
LGAM0400 
LGAM0410 
LGAM0420 
LGAM0430 
LGAMO440 
LGAM04S0 
LGAM0460 
LGAM0470 
LGAMOABC 
LGAM0490 
LGAMOSOO 
LGAMOSIO 
LGAM0S20 
LGAM0530 
LGAM0540 
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LGA 

Ml  -  L0G  0F  THE  GAVMA  FLNC 

LOG 

C0MM«N+CCO2,O 

KMP 

C0MM0N+COO1.O 

Fse 

A07<33.0 

FAC 

00751 .0 

ST0 

C0MM0N+CCOO.O 

LCO 

A07<;e.o 

FMP 

eo79e.o 

ChS 

.0 

FAC 

C0MM0N+CCOO,O 

hJH) 

C0Vf'0N  +  CCO3,O 

LCQ 

A07qe .0 

FMP 

C0MM0N+OOO1 tO 

FSH 

A07qe.O 

ST0 

C0MM0N+COOO.O 

LCG 

C0MM0N+COOP.O 

FVP 

B07qe  ,0 

FAC 

C0MM0N+COOO.O 

ST0 

C0^'MeN♦ooo2.o 

CLA 

A07q3,0 

STK 

ceMM0N+coo4,o 

CLS 

A07qf ,0 

bT0 

C0MM0N+COO5,O 

CLA 

H0797.0 

ST0 

C0MM0N+COO1 tO 

LXA 

A0791 .4 

D0793  CLA 

n079i;,4 

FOH 

C0MM«?N  +  COO1  .0 

STQ 

C0MM«N+CCOO.O 

FMP 

C(?MM0N  +  COO4,O 

FAC 

A07q3.0 

ST« 

C0MM0NtCOO4,O 

LCC 

C0MM0N+COOO.O 

FMP 

C0MM0N-fCCO5.O 

FAD 

A079t.C 

CHS 

.0 

STe 

C0MM0N+COO5,O 

LOG 

C0MM0N+CCO5.O 

FMP 

ceMWfN+coos.o 

ST« 

C«!MM{!NtOOOO.O 

LCG 

C0MMHN+COO4.O 

FMP 

C0MM0N+CCO4 .0 

FAC 

C0yMKN+ccoo.o 

STU 

ceMMt^N  +  cooi.c 

T  IX 

00793. A. COOl  . 

CLA 

C0MM0N+CCO4.O 

Fse 

A0793.C 

FAC 

C0MM(«N  +  COO3.O 

bT0 

C0MMeN+CCO3.O 

CLS 

C0MM0N+CCO5.O 

Fse 

AC79e ,0 

FAC 

ceMMKN+ocop.o 

ST0 

C0MM0N+CCO2.O 

C079O  TRA 

0079^,0 

D07<;^  CLA 

AC794 .C 

rPL 

0  0  7  9  f .  ,  0 

[0N     F0K     Ce^fPLEX     ARGUMENT     -     FAP     C0CED 


Ce^PUTE 
BE        LN 
G  AIKMA 
Z 
KINLS 

RE      J 

STBRE  ABBVE 


STBRE  AB0VE 
START 
J     FRACT 


RE  LN  GAMMA 


[M  LN  GAMMA 


LGAM0550 
LGAM0560 
LGAM0570 
LGAMOSeC 
LGAMC590 
LGAM0600 
LGAMOeiO 
LGAMOeZO 
LGAMCe30 
LGAM06AO 
LGAMOeSO 
LGAM0660 
LGAM0670 
LGAM0680 
LGAM0690 
LGAM0700 
LGAM0710 
LGAM0720 
LGAM0730 
LGAM07AC 
LGAM0750 
LGAM0760 
LGAM0770 
LGAM07eO 
LGAM0790 
LGAMOeOO 
LGAMOeiO 
LGAM0e20 
LGAMOeSO 
LGAMOSAC 
LGAMOeSO 

LGAMceeo 

LGAM0e7C 

LGAMoeao 

LGAM0e90 
LGAM0900 
LGAMC91C 
LGAM0920 
LGAM0930 
LGAM094C 
LGAMC950 
LGAM0960 
LGAM0970 
LGAM09eO 
LGAM0S90 
LGAMICOO 
LGAMIOIO 
LGAM1C20 
LGAM1C30 
LGAMIOAC 
LGAM1050 
LGAM1C60 
LGAM1C70 
LGAMlOeO 
LGAMJC90 
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LCAMl  -  L0G  0F  THE  GAf 


F0B  CefPLEX  ARGUMENT  -  FAP  C0CEO 


TZe  D07S5.0 

TWA  D079e.O 

0079b  CLA  C0My0N+OOO3.O 

LCG  C0yM0N+CCO2.O 
LXC       Kt.t 

A0797  5T0  .0 

AOVQS  STO  ,0 

THA       5.4 

10795  CLA  C0MM0N+CCO3.O 

FSe  B079i!.0 

ST0  C0MM0N+OOO3.C 

CLA  C0MM0N+CCO2.O 

FSB  B0791.0 

ST0  C0MM0N+CCO2,O 

CLA  00797,0 

STA  CC79e,0 

TRA  00794,0 

B0793  CLA  00798,0 

ST0  C0MM0N+COOO.O 

LCG  A079C.0 

TOP  E0791,C 

CLS  E0792,0 

ST0  B079f..O 

TRA  E0793,0 

G0791  CLA  E0792,C 

ST0  B0796,0 

TRA  E0793.0 

H0794  CLA  0079e,0 

ST0  E0794,0 

ST0  E0795.0 

ST0  E079fc,0 

E0797  LOO  A0793.C 

FMP  A0793,0 

ST0  C^MMfN+OCOO.O 

LOG  A079e.O 

FMP  A079e,0 

FAC  C0yN'f  N  +  OOOO.C 

TSX       SL0C,4 

FDH  C0792,0 

5TQ  c0^'^0N♦ccoo.o 

CLA  C0N'N'eN  +  CCOO,O 

FAC  E0794.0 

ST0  E0794,0 

CLA  A079f .0 

FCF  A0793,0 

STG  C0MM0NtOCOO.C 

CLA  C0MyeN+OCOO,C 

TSX       J  AT  AN , 4 

FAD  E0795,0 

ST0  E0795,0 

CLA  t079e,0 

AUC  00792,0 

ST0  E0796,0 

CLA  A0793,0 

FAC  C0794,0 


•AS   NEGATIVE 


EQUALS 

ZER0 


LGAMllOO 
LGAMt 110 
LGAM1120 
LGAMl 130 
L6AM114C 
LGAMllSO 
LGAMl 160 
LGAMl 170 
LGAMlieO 
LGAM1190 
LGAM1200 
LGAM1210 
LGAM1220 
LGAM1230 
LGAM124C 
LGAM1250 
LGAM1260 
LGAM1270 
LGAM12e0 
LGAM129C 
LGAM1300 
LGAM1310 
LGAM1320 
LGAM1330 
LGAM134C 
LGAM1350 
LGAM1360 
LGAM1370 
LGAMlSeO 
LGAM1390 
LGAM1400 
LGAM141C 
LGAM1420 
LGAM1430 
LGAM144C 
LGAM1450 
LGAM1460 
LGAM1470 
LGAMiaeO 
LGAM1490 
LGAM1500 
LGAM1510 
LGAM1520 
LGAM1S30 
LGAM154C 
LGAM1S50 
LGAM1560 
LGAM1570 
LGAM1580 
LGAM1590 
LGAM 1600 
LGAM 16  10 
LGAM1620 
LGAM1630 
LGAMieAC 
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LGAMl     -     LOG     0F     THE     GANMA     FtNCTieN    F0fi    Ce^'FLE; 


bI0 

A079J,0 

Tze. 

NEXT 

TMJ 

(r  0  7  9  7  ,  C 

Nt-:xT 

CLA 

FC796.0 

Ler 

.0 

THA 

C0797,0 

CLA 

E079E.0 

F4C 

E079t<.0 

■610 

E0795 ,0 

T«A 

C0797,0 

00796 

CLA 

C0MMIZN  +  CCO3.O 

FSB 

E0794 , 0 

ST0 

C0^'M^'N  +  COO3,O 

CLA 

ceMM0N+oco2.o 

FS9 

E0795.0 

STa 

C0I'M2N*COO2.O 

THA 

C0795 .0 

DO  798 

HTR 

.  C 

C0794 

DtC 

♦l.CCCOCCOOCOOE+00 

C0792 

DEC 

+2.0CCCCCOOOOOE+00 

CO  790 

oec 

♦5.CCC0CCOOC0OE-O1 

e0792 

DEC 

+l.E7C79e32e79E*00 

E079t3 

DEC 

*2.   14159265359Et00 

H0795 

DEC 

♦  1.  14472908Ee5E*00 

00791 

DEC 

♦  9.  1893ee33200E-0l 

HO  796 

DEC 

♦2.2694ee974COE+00 

H0797 

DEC 

♦1.E1747364900E+00 

H079d 

OEC 

+  1.01  152306800E  +  00 

10791 

DEC 

♦5.2EeOf469C0OE-01 

10792 

DEC 

+2.523aC9524C0E-01 

10793 

OEC 

♦3.33333333333E-02 

10794 

DEC 

♦e.33332333333E-02 

DO  792 

HTM 

0001, C 

A0791 

HTR 

0007, C 

A079J 

HTH 

,0 

A0790 

HTR 

,C 

90  796 

HTH 

,0 

00797 

HTR 

•  C 

60796 

HTR 

,0 

50794 

HTH 

.0 

E079b 

HTR 

.0 

B0791 

HTR 

.0 

30792 

HTR 

.0 

C0795 

HTR 

10795,0 

40794 

HTR 

.0 

00797 

HTH 

D0794.0 

Ca^MKN   -20e+5 

liivveN 

C4)MM0N    1 

X4 

HTR 
END 

,0 

IS     X     PLUS      1 

F0SIT IVE 
TEST  K 

K        C>CO 


CeNSTANTS 


INTERNAL        STBRACI 


LGAMieSO 

LGAMieeo 

LGAM 1670 
LGAM  1680 
LGAM1690 
LGAM1700 
LGAM17 IC 
LGAM 1720 
LGAM1730 
LGAM174C 
LGAM1750 
LGAM 1760 
LGAM1770 
LGAM17eO 
LGAM1790 
LGAM1800 
LGAM18 10 
LGAM1820 
LGAM1830 
LGAM 184C 
LGAMISEO 
LGAMia60 
LGAMie70 
LGAM1880 
LGAMie9C 
LGAM1900 
LGAM191C 
LGAM1920 
LGAMig30 
LGAM194C 
LGAM 1950 
LGAM 1960 
LGAM1970 
LGAM19eC 
LGAMiq90 
LGAM2000 
LGAM2010 
LGAM2020 
LGAM2030 
LGAM204C 
LGAM20E0 
LGAM2060 
LGAM2070 
LGAM20eC 
LGAM209C 
LGAM2100 
LGAM21 10 
LGAM2120 
LGAM2130 
LGAM2 14C 
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Identification:   LGAM2  -  Log  of  the  Gamma  Function 

for  Complex  Argument 
FORTRAN  II  Coded  -  709^ 
Purpose:   To  compute 

U  =  real  part  of  In  |~"  (x+ly) 
and 

V  =  Imaginary  part  of  In  ]"   (x+ly) 
where  x  and  y  are  normalized  floating 
point  numbers . 
Restrictions:   See  write-up  for  FAP  version  of  LGAM. 
Method:   See  write-up  for  FAP  version  o f  LGAM. 
Usage:     Same  as  for  PAP  version  of  LGAM. 
Accuracy:  Same  as  for  FAP  version  of  LGAM. 
Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
A TAN,  L0G 

The  routine  also  uses  the  subroutines  necessary 
to  write  an  output  tape.   These  subroutines  are 
discussed  more  fully  in  the  last  section  of  this 
report . 

b)  System  Built-in  Functions  (open  subroutines) 
XM0D 

c)  Storage 

383-,Q  =  577o  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:   M.  Goldstein  and  Miriam  Shapiro 
Date:   November  1964 


•E  GA^/MA  FUNCTIe^  F0B  Ca^'PLEX  ARGUMENT  -  F0RIRAN   II  C0DED 


CLeCGAM   L0G  0F  THE  GAVKA  FUNCTIKN  CF  CBfPLEX  AfiGLKENTS   F0RTKAK   II 

SUeRBUTINF  L0GGAV( X, Y.Ut V) 
:   THIS  i>ueR0LTINF  C0MPLTES  THE  NATURAL  LBG  ZF     THE  GAf»MA  FUNCTI0N  F0f 
C  CeWPLEX  ARGUMENTS.    THE  R0UTINE  IS  ENTERED  BY  THE  STATEMENT 
C       CAUL  L0GGAM( X.Y.L. V) 

C  WhERE     X   IS  Tt-E  REAL  PART  0F  THE  ARGUMENT 
C  Y   IS  THE  IMAGINARY  PART  0F  THE  ARGUMENT 

C  U  IS  THE  HEAL  PART  0F  THE  RESULT 

C  V  IS  THE  IMAGINARY  PART  0F  THE  RESULT 

DIMENS I0N  HI  7 ) 

H( I )=2. 265466974 

H( 2)=1 .517473649 

H( 3)=1 .01 1523C68 

H(4 )=5.2£e0e4t90E- 1 

HI  5  )=2.523e0?524E- 1 

H( 6)=3.3333J3333E-2 

H{ 7)=e.333333333E-2 

E2=l .57079632679 

E8=3. 141=9265359 

81=0.0 

B2=0.0 

J  =  2 

X2  =  X 

4  IF( X  )  1  .2,3 

2     B6  =  ATANF( Y/X  ) 
T=X»»2 

5  B7=Y««2tT 

C   REAL  PART  0F  L0G 
T1=.5«L0GF(Q7) 
IF( X-2.0 )7.7,6 
7  B1=BJ+Re 
B2=B2+T1 
X=X+ 1 .C 


J=l 


T5  =  -Y 

Tl=fi7 

D0  e  1=1.7 

T=H( I )/Tl 


'(  X-.5)- 
Y»T1-Y 


v9. ie93aE332E-l ) 


T4  +  X 


T3=T4-X+T3 

T2=-T5-Y+T2 

G0  T0  (9.10) 

.J 

9 

TJ=T3-B2 
T2=T2-R1 

10 

IF(X2)  1  1  .  12. 

12 

12 

U=T3 
V  =  T2 
X  =  X2 
RETURN 

FLGMOOIC 
FLGM0020 
FLGM003C 
FLGM004C 
FLGMOOSO 
FLCM0060 
FLGM007C 
FLGMOOSO 
FLGM0090 
FLCMOIOO 
FLGMOl 10 
FLGM0120 
FLGM0130 
FLGM014C 
FLGM015C 
FLGM0160 
FLGMOl 70 
FLGMOieC 
FLGM019C 
FLGM0200 
FLGMC210 
FLGM0220 
FLGM023C 
FLGM0240 
FLGMC250 
FLGM0260 
FLGM0270 
FLGM02aC 
FLGM029C 
FLGM0300 
FLGM031C 
FLGM0320 
FLGM0330 
FLGM034C 
FLGM0350 
FLGM0360 
FLGM0370 
FLGM03eC 
FLGM039C 
FLGM040C 
FLGM0410 
FLGM0420 
FLGM043C 
FLGM044C 
FLGM04SO 
FLCM0460 
FLGM0470 
FLGM0480 
FLGM0490 
FLCM0500 
FLGM051C 
FLGM0E2O 
FLGMC530 
FLCM054C 
FLGM055C 
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L0AM2    -    LfJO     J!F     Tee     GACK*     FUt.CTIKt      F8i(;     CKKf-LE/     APCOXEM     -     FBfilkAH      II     CaOPO 

II     U=T3-e4  FLCMC^fcO 

V=TZ-eS  FLCMC570 

X=X2  FLCMOSeO 

BKTORN  FLCMC;90 

X    IS   ^ep^  flcmo<oo 

2  T=C.O  FLCMOeiO 

IF( y ) 1 3. It. l^  FLGMOeZO 

13  Bo=-ei;  FLC-Moeso 

C0     T0     =  FLCM064C 

It    66=62  FLCMOeSO 

G0     Ta     t  FLCM0C60 

/     IS    NECATIve  FLCM0C70 

1     e4=C.O  FLCMOCeC 

E5=C.O  FLCMOeSC 

iee=0  FLCM070C 

le     E4=fe4*. t'CLKGF ( /••i* r»»2) )  FLCM0710 

ei  =  E5  +  AT*>^F  (  /// )  FLCM0720 

ie6=IEe»l  FLCMO730 

X  =  /'H.C  FLCM0740 

IF<  X  )  IC,  17,  17  FLC*I0750 

17    iF(x»'(jcF(  lee.S') )  ie,«,  ifi  flcmo7«o 

le     fc5=E5*Fe  FLGM0770 

Ga     TO     4  FLCM078C 

14  mKITE     iJOTPLT     TAPE  t,19,/(2.ir                                                                                                                              FLCM0790 
1^    FUKMATta-SH     ATTEMPTED     T0     TAKE     LKGGAK     KF     2F  /  ^F  fc  .  0  .  I /2v-r  =F<  .  C  )  FLCMCeOO 

CALL     E/IT  FLCKOeiC 

E'JC  FL'.fCSZC 


Ordinary  Differential  Equations 

1.  DEQ   Gill's  Variation  of  Runge-Kutta  -  FAP  Coded 

2.  RUNGS  Single-Precision  Runge-Kutta  -  FORTRAN  Coded 
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Identification:   DEQ,  -  Ordinary  Differential  Equations 
Solution  (Runge-Kutta) 
FAP  Coded  -  70 90 
Purpose:   To  Integrate,  stepwise,  a  set  of  n  simultaneous 
first  order  differential  equations  of  the  form: 
,  _   dy. 
^1  =   d^  =  fi(x,y^,y2,...,y^) 

where 

1  =  1,2, . . .,n. 

Method:    Uses  Gill's  variation  of  the  Runge-Kutta  Method. 
See  Gill,  S.,  "A  Process  for  Step-by-Step 
Integration  of  Differential  Equations  In  an 
Automatic  Digital  Computing  Machine,"  Proc . 
Camb.  Phil.  Soc,  47  (1951),  PP  •  96-108. 

Description:   Before  calling  this  subroutine,  an  Initial 
value  for  X  and  an  array  Y  which  contains  the 
Initial  values  of  y,,...,y  must  be  supplied  by 
the  programmer. 

A  subroutine  for  computing  and  storing  the 
derivatives  y.'  In  an  array  YPRIME  must  also 
be  supplied  by  the  programmer. 

DEQ  enters  the  derivative  subroutine;  therefore 
the  arguments  of  this  derivative  subroutine  must 
conform  In  number,  order  and  mode  to  those  which 
DEQ  expects.   These  requirements  are  given  below. 

The  first  pass  through  DEQ  produces  no  Integration 
but  returns  with  the  Initial  value  of  x  unchanged, 
the  Initial  values  of  y^,...,y^  In  Y,  and  the 
derivatives  In  YPRIME.   Thereafter,  for  each 
entry  Into  the  subroutine,  the  program  produces 

X  +  h,  y-j_(x+h),  ...,  y^(x+h),y^(x+h),  .  .  .,y^Cx+h)  . 

That  Is,  after  each  entry,  the  subroutine  returns 
after  completing  the  evaluation  of  the  derivatives 
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and  not  after  only  evaluating  the  new  y's. 
Usage:     Enter  DEQ  by: 

CALL  DEQ(X,H,N,Y,YPRIME,Q,NAME) 
The  symbols  shown  as  arguments  may,  of  course, 
be  replaced  by  any  appropriate  variable  names; 
however,  the  arguments  except  for  H  must  be 
identical  with  those  of  the  last  given  initiali- 
zation.  H  may  be  changed  at  will  by  redefining 
it  before  each  reference  to  the  call. 
The  symbols  represent  the  following  variables: 

X       Independent  variable. 

The  programmer  must  supply  the  initial 
value  before  entering  DEQ. 

H       Increment,  Ax,  may  be  changed  in  value 
before  each  reference  to  the  call. 

N       Number  of  equations . 

Y       Dependent  variable  block,  a  one-dimensional 
array  of  dimension  >   N.   The  programmer 
must  supply  initial  values  of  y-,  ^y^^  •  •  •  jY^ 
in  this  block  before  entering  DEQ.   This 
block  will  contain  subsequent  values  of  y. 

YPRIME  Derivative  block,  a  one-dimensional  array 
of  dimension  _>  N.   The  subroutine  supplied 
by  the  programmer  to  evaluate  the 
derivatives  should  store  the  computed 
derivatives  in  this  block. 

Q       Temporary;   storage,  a  one-dimensional 
array  of  dimension  _>  N  to  be  used  only 
by  DEQ  to  carry  the  integration  forward. 
On  the  first  pass,  DEQ  sets  this  block 
to  zero.   The  information  in  this  block 
is  then  carried  from  step  to  step  in 
order  to  minimize  rounding  error. 


Notes: 


NAME    The  name  of  the  subroutine  written  by  the 
programmer  to  compute  and  store  the 
derivatives.   The  FORTRAN  rules  require 
that  when  a  subroutine  name  Is  to  appear 
in  an  argument  list  of  a  subroutine,  the 
subroutine  name  must  appear  in  an  F  card. 
The  F  card  may  appear  anywhere  in  the  deck 
containing  the  CALL  to  DEQ.   F  must 
appear  in  Column  1.   See  FORTRAN  Reference 
Manual  for  7090/709^,  form  C28-6054. 
This  subroutine  must  be  coded  as  a  subroutine 
subprogram  using  the  statement 

SUBR0UTINE  NAME  (X,N,Y,YPRIME) 
where  the  symbols  have  the  same  meaning  as 
described.   The  routine  should,  of  course,  select 
X  from  X,  the  y's  from  Y  and  store  the  derivatives 
in  YPRIME .   The  four  arguments  must  appear  In 
this  order,  none  may  be  omitted. 


a)  As  the  integration  is  carried  forward,  the 
previous  values  of  the  variables  are  destroyed 
by  the  program  so  they  should  be  saved  by  the 
programmer  if  they  are  needed  for  future  use. 

b)  If  at  any  time  one  desires  to  restart  the 
integration  either  to  solve  a  different  set  of 
differential  equations  or  to  start  with  new 
initial  conditions,  without  reloading  the  deck, 
it  is  necessary  to  use  the  statement 

CALL  DEQSET 
before  using  CALL  DEQ  (arguments  as  described). 
The  Q,  block  will  also  be  set  to  zero.   DEQSET 
is  an  alternate  entry  in  DEQ. 
Requirements : 

Storage 

106-,(^  =  l52o  locations  plus  the  absolute  locations 
77775Q-777773  i'or   temporary  storage. 
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Author:   M.  Goldstein 
Date:     October    I96I 

Example: 

Use  the  above  routine  to  solve  the  following  three  simultaneous 

first  order  differential  equations 

from  u  =  0  to  1.0  with  Au  s  h  =  .1  until  u  =  .5 

and  then  h  =  .05  until  u  =  1.0 

dx  dy  dz     1 

dn  =  y^'       dH  =  -^^'       d^  =  -  2  ^y 

with  initial  conditions  x=0,  y=l,  z=latu=0. 
(This  system  of  equations  has  as  its  solution  the  elliptic 
functions  of  Jacobi 

X  =  sn(u,k),   y  =  cn(u,k),   z  =  dn(u,k) 
for  the  particular  case  where  k^  =  1/2.) 
For  purposes  of  notation,  let  x  =  z-,  ,   y  =  Zp,   z  =  z', 
we  then  have 

'  -  '  -_         '  -  _  1 

^1  "  ^2^3  '         ^2  ~  ^1^^'         ^3  ~    2  ^1^2  * 

A  possible  FORTRAN  code  that  will  solve  this  problem  and 

print  after  each  cycle  may  be  written  as  follows: 


C         MAIN  TEST  OF  DEQ  SUBROUTINE 

DIMENSION  ZC3),  ZPRIME(3),  TEMP (5) 
C  DEFINITIONS  BEFORE  ENTRANCE  TO  DEQ 

N  =  3 

H  =  .1 
F  DER 

C         SET  INITIAL  CONDITIONS 

U  =  0.0 

ZCD  =  0.0 

Z(2)  =  1.0 

Z(3)  =  1.0 
101   CALL  DEQ(U,H,N,Z,ZPRIME, TEMP, DER) 

PRINT  1,U,Z(1) ,Z(2),Z(3),ZPRIME(1),ZPRIME(2), 
C  ZPRIME(3) 

IF  (U-. 499995)  101,101,201    (^^^^,^_  ^^  ^^^,  p^g^) 
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201   H  =  .05 

TEST  IF  U  =  1.0 

IF  Cu- -999995)  101,101,104 
104   CALL  EXIT 

1   FORMAT  (IP7EI7.7) 

END 


DER  SUBROUTINE  TO  COMPUTE  DERIVATB/E.S 

SUBROUTINE  DER(U,N, Z, ZPRIME) 

DIMENSION  Z(3),  ZPRIME(3) 

ZPRIME,(1)  =  Z(2)*Z(3) 

ZPRIME(2)  =  -Z(1)*Z(5) 

ZPRIMEC5)  =  -,5*Z(1)*ZC2) 

RETURN 

END 
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Purpose 
Method: 
Usage: 


Identification:   RUNGS  -  Runge-Kutta  Method  fcr  Solving 
a  Set  of  n  Simultaneous  First 
Order  Differential  Equations 
—  Single  Precision 
FORTRAN  II  Coded  Subroutine  -  7O9O 
See  write-up  for  DEQ. 
See  write-up  for  DEQ. 

CALL  RUNGS (X , H , N , Y , YPRIME , NAME , INDEX ) 
where 
X,H,N,Y, YPRIME  and  NAME  are  as  described 
in  the  write-up  for  DEQ 
and 
IlxTDEX  is  a  variable  which  should  be  set  to 
zero  before  each  initial  entry  to  the 
subroutine,  i.e.,  to  solve  a  different 
set  of  differential  equations  or  to  start 
with  new  initial  conditions. 

The  subroutine,  as  written,  contains 

DIMENSI^^N  statements  for  Y  and  YPRIME  reserving 
50  locations  for  each.   In  addition  6  other  one 
dimension  arrays  are  used  within  the  subroutine, 
each  of  50  locations.   Therefore,  as  written,  N 
may  not  be  greater  than  50  and  the  dimensions 
for  Y  and  YPRIME  in  the  calling  program  must 
also  be  set  at  50 . 

The  dimensions  of  all  these  arrays  may  be  changed 
by  altering  the  DIMENSION  statements  in  the 
subroutine  without  affecting  the  code  and, 
furthermore,  must  be  changed  to  agree  with  the 
dimension  for  Y  and  YPRIME  In  the  calling  program. 
Requirements: 

Storage;   506-,^  =  772o  locations 


Restrictions 


506^0  =  772^ 


Author:    Eva  Swenson 
Date:   October  I963 
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RUNGE-KLTTA  S0LtTI0N  0F  SET  0F  FIRST  0RCEB  0.0. E. 


i         SINGLE  PRECISIBN  RUNGE  KLTT*.                                         RUNGSOIO 

E  SWENS0N    10/15/63    I  R0LTINE.  SEE  WRITEUP  AND  RUNGS020 

SEE  NUDEC  »BITEl;P  F0R  MEANING  0F  ARGUMENTS  EXCEPT  F  0R  INDEX.  RUNGS030 

SUBR0UTINE  RLNGS  (  X , h , N , Y , YPR I  ME . N AME , INOE X )  RUNGSOAO 

CIMENSI0N  Y(50  ),YPRIME  (50)  RUNGS050 

DIMENSI0N  *(50).Z<50)  RUNGS060 

DIMENSI0K  lil  (  £0)  .»2(50)  .»3(5C  )  .l»A  (50)  RUNGS070 

IF( INDEX )5.S. 1  RUNGS080 

OH  2   1=1, N  RUNGS090 

Wl  (  I  )=t-»YPHIME  (  I  )  HUNGSIOO 

Z(  I  )=Y(  I  )♦(»!  (  I  )«.5)  RUNGSllO 

A  =  X  +  (l-/2.0)  RUNGS120 

CALL  NAME( A.N.Z, YPRIME  )  RUNGS130 

00  3  1=1 ,N  RUNGS140 

W2(  I  )=H»YPRiyE ( I  )  RUNGS150 

Z(  I  )  =  Y{  I  )♦  (l.2(  I  )».£)  RUNGS160 

A=X*(H/2.0)  HUNGS170 

CALL  NAME( A.N, Z, YPRIME )  RUNGS180 

DM  4  1=1. N  RUNGS190 

W3(  I  )  =  I-»YPRIME  (  I  )  RUNGS200 

Z(  I  )=Y(  I  )  +  »3(  1  )  RUNGS210 

A  =  X  +  I-  RUNGS220 

CALL  NAME! A.N.Z. YPRIME )  RUNGS230 

00  7  1=1, N  HUNGS240 

W4(  I  )=(-«YPRIME(  I  )  RUNGS250 

Y(I)=Y(I)+(((2.0»(»(2(I)  +  »3(I)))  +  *l(I)*»4(I))/6.)  RUNGS  260 

X=X+H  RUNGS270 

CALL  NAME(  X.N.  Y. YPRIME  )  RUNGS280 

G0  T0  6  RUNGS290 

CALL   NAME( X.N, Y, YPRIME )  RUNGS300 

IN0EX=1  RUNGS310 

RETURN  RUNGS320 

END  HUNGS330 
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Elliptic  Integral 
1.   ELINT   Elliptic  Integral  Function  -  FAP  Coded 
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Identification:   ELINT  -  Elliptic  Integrals  Function 

Subroutine  -  709O  -  FAP  Coded 
Translated  from  SAP-704  code 
LA  S865  written  at  Los  Alamos 


Purpose: 

To  compute 

K(X,Y)   = 

X 
0   yi-Y^  sln^  t 

E(X,Y)  -- 

X 
=   /yi-Y^  sln^  t  dt 
0 

where: 

0  ^  X 

<   7r/2,   0  <  Y  <  l.( 

Usage: 

There  are  two 

entries  to  this  sub: 

ELK:   for  Incomplete  elliptic  Integral,  first  kind 
ELE:   for  Incomplete  elliptic  Integral,  second  kind 
and  are  used  as  follows: 

In  FORTRAN  In  FAP 

P  =  ELK(X,Y,IP)  CALL  ELK,  X,Y,IP 

Q  -  ELE(X,Y,IQ)  ST0  P 

or 

CALL  ELE,  X,Y,IQ 
ST0  Q 
where: 

X,Y       are  defined  above 

IP,IQ     are  error  flags  whose  contents  will 
be  set  by  ELINT  as  follows  upon  exit 
from  ELINT. 
IPorIQ=0:  computation  has  been  successfully 

completed 
IPorIQ=l:  X  or  Y  Is  out  of  Its  proper  range. 
I.e.,  one  of  the  following: 


X  ■ 

<  0.0 

Y  ■ 

<  0.0 

X  >  1.5707965 

Y  >    1.0 
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IP  =-1:         Y  sin  (X)  =  1.0,  I.e. 

the  function  K(X,Y)  does  not  exist. 

N.B.     ■  the  integers  IP  and  IQ  are  stored 

in  the  decrement  part  of  the  words . 
Accuracy:  As  per  LA  S865  writeup:   Prom  5  to  8  significant 

figures  depending  on  the  values  of  X  and  Y. 
Requirements : 

Storage 

390^pj  =  6060  locations 
Author:   George  Logemann 
Date:   November  I962 
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ELLIPTIC  INTEGRALS  FLNCTIBN  SueBBLTINE  -  FAP  C0CED 
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INTtGRALS    FLNCTIKN     SUeRZUI 


F*P  C0CEC 


HERE  BEGINNETH  LASe65 

ADDRESSES  K0DIFIED 
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ELNT 1080 
ELNT 1090 
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4TEGRALS    FUNCTieN     SUERBUTINE    -    F*P     CflCEO 
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C«9 

L273 

CLA 

C  +  4 

L27A 

FAC 

C  +  13 

THA 

LiS-* 

L27e 

CLA 

C+15 

FAC 

C  +  10 

ST0 

C41C 

CLA 

CiM 

ELNTieSO 

ELNTieeo 

ELNT1670 
ELNT 1680 
ELNT1690 
ELNT 1700 
ELNTWIO 
ELNT  1720 
ELNT1730 
ELNT174C 
ELNT175C 
ELNT 1760 
ELNT1770 
ELNT17eO 
ELNT 179C 
ELNT 1800 
ELNT 18  10 
ELNT1820 
ELNT 1830 
ELNT184C 
ELNT 1850 
ELNTieeo 
ELNT 1870 
ELNT 1880 
ELNT189C 
ELNT1900 
ELNT 1910 
ELNT 1920 
ELNT 1930 
ELNT19AC 
ELNT155C 
ELNT1960 
ELNT 1970 
ELNT 1980 
ELNT199C 
ELNT2000 
ELNT2010 
ELNT2020 
ELNT2030 
ELNT20AC 
ELNT20S0 
ELNT2060 
ELNT2070 
ELNT2080 
ELNT2090 


EL^ 


2100 


ELNT21 10 
ELNT2120 
ELNT2130 
ELNT214C 
ELNT21S0 
ELNT2160 
ELNT2170 
ELNT2ie0 
ELNT219C 
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FAC       C+9  ELNT2200 

ST0       C+9  ELNT2210 

TNX       L3AS,2.1  ELNT2220 

CLA       C+11  ELNT2230 

LCC       C+13  ELNT2240 

ELNr22S0 
ELNT2260 
ELNT2270 
ELNT22eO 
ELNT2290 
ELNT2300 
ELNT2310 
ELNT2320 
ELNT2330 
ELNT2340 
ELNr23S0 
ELNT2360 
ELNT2370 
ELNT2380 
ELNT2390 
ELNT2A00 
ELNT2410 
ELNT2020 
ELNT2A30 
ELNT2440 
ELNT2450 
ELNT2460 
ELNT2470 
ELNT24eO 
ELNT24gO 
ELNT2500 
ELNT25I0 
ELNT2520 
ELNT2530 
ELNT2540 
ELNT2550 
ELNT2560 
ELNT2570 
FOH  ELNT2580 

ELNT2S90 
ELNT2600 
EUNT2610 
ELNT2e20 
FCH  ELNT2630 

ELNT264C 
ELNT2650 
ELNT2e60 
ELNT2670 
ELNT2680 
ELNT2690 
ELNT2700 
ELNT27I0 
EUNT2720 
ELNT2730 
ELNT2740 


TLO 

L33e 

FAC 

L0C5 

sue 

L41  1 

ST0 

C*ll 

LCC 

C+4 

FMP 

C  +  IC 

FAC 

c*e 

STB 

C  +  8 

LCC 

C+4 

FMP 

C+9 

FAC 

C  +  7 

ST0 

C  +  7 

CLA 

C+15 

ST0 

C  +  IC 

CLA 

C  +  l-* 

ST0 

C  +  9 

pxc 

0.2 

ALS 

I 

POX 

0.2 

CLA 

C  +  4 

sue 

Lii  1  1 

ST0 

C  +  4 

TRA 

L27ft 

CLA 

C*lt 

FAC 

C  +  IC 

STB 

C  +  IC 

CLA 

C  +  14 

FAC 

C  +  9 

ST0 

C+9 

TRA 

L273 

LCC 

C  +  i* 

FMP 

C  +  IC 

FAC 

c  +  e 

FDI- 

L413 

STC 

c  +  e 

LCC 

c+4 

FMP 

c  +  9 

LXC 

C+12.2 

L3tC 

LXD 

C  +  6.4 

T«A 

3  .4 

L3e2 

DEC 

1.386294361 

L3e3 

DEC 

.097932891 

L3t4 

DEC 

.054544409 

L3e5 

DEC 

.032024666 

L3e6 

DEC 

.5 

L3e7 

DEC 

. 124750742 

L370 

DEC 

.060118519 
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L371 

DEC 

.010^44912 

L372 

DEC 

.44479204 

L373 

DEC 

.085099193 

L374 

DEC 

.040905094 

L375 

DEC 

.249697949 

L37e 

DEC 

.06150224 

L377 

DEC 

.01362999 

L«CO 

DEC 

.004 

L4C  I 

DEC 

.0004 

LAC2 

0CT 

201622047007 

L4C3 

DEC 

.99999997 

Lao 

DEC 

1  .0 

L4C5 

DEC 

1  .57079632679 

L4Ce 

DEC 

1  .3 

L4C7 

0CT 

0C0C240C0000 

L4  10 

DEC 

40.0 

La  1  1 

0CT 

OCIOOOOCOOOC 

L4  1? 

0CT 

0C2CCO0CO0O0 

L413 

DEC 

J.O 

Lt   14 

T^^E 

1  •  4 

TMI 

1  .4 

Lr^S 

27 

STG 

C 

ALS 

19 

IdHA 

L452 

FSB 

L453 

ST0 

C  +  1 

CLA 

C 

LRS 

e 

b)P<A 

L454 

L427 

FAC 

L455 

ST0 

C 

Fse 

L45e 

FDF 

C 

STG 

c 

FMP 

c 

ST0 

C*2 

LCO 

L461 

FMP 

C*2 

FAC 

L4e0 

LRS 

35 

FMP 

C  +  2 

FAC 

L457 

L444 

LRS 

35 

FMP 

C 

FAC 

C+1 

LRS 

35 

FMP 

L462 

TRA 

2.4 

L4t2 

0CT 

21OCCOOO0COO 

L453 

DEC 

126.5 

L4E4 

0CT 

2C00COCC000C 

L455 

DEC 

.707106761167 

L456 

DEC 

1  .41421356237 

L457 

DEC 

2.8653912903 

ELNT2750 
ELNT2760 
ELNT2770 
ELNT27eO 
ELNT2790 
ELNT2600 
ELNT2810 
ELNT2e20 
ELNT2e3C 
ELNT2e4C 
ELNT2850 
ELNT2860 
ELNT2e70 
ELNT2e8C 
ELNT2690 
ELNT2900 
ELNT291C 
eLNT2920 
ELNT2g30 
ELNT294C 
ELNT2950 
ELNT2960 
ELNT2970 
ELNT2980 
eLNT2990 
ELNT3000 
ELNT3010 
ELNT3020 
ELNT3030 
ELNT304C 
ELNT3050 
ELNT3060 
ELNT3070 
ELNr308C 
ELNT3090 
EL  NT  3 100 
ELNT3  1  10 
ELNT3120 
ELNT3130 
eLNT3  14C 
ELNT3150 
ELNT3160 
ELNT3170 
ELNT3ieO 
eLNT3190 
ELNT3200 
ELNT3210 
ELNI3220 
ELNT323C 
ELNT324C 
ELNT3250 
ELNT3260 
ELNT3270 
ELNT3280 
ELNT3290 
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L4£0 

DEC 

.9614706323 

L4ei 

DEC 

.5969786496 

LACZ 

DEC 

.69314716056 

L4e3 

FAC 

L54e 

L4e4 

FAC 

L544 

LDQ 

L547 

ST0   ' 

C 

SSP 

TLQ 

L535 

sue 

L544 

TMI 

L520 

LPS 

27 

STA 

L47e 

L475 

PXD 

4.0 

L476 

LLS 
LPS 

0 

CVH 

L55C 

ST0 

C»l 

HGL 

34 

PXC 

0.0 

LLS 

1 

TZE 

L507 

CLA 

L55C 

L5C7 

sue 

C*l 

LLS 

0 

LCO 

c 

TOP 

L514 

L513 

CHS 

L£  14 

LHS 

e 

0RA 

L545 

FAC 

L54S 

bin 

c 

L520 

LDC 

c 

FMP 

c 

ST0 

C+1 

LCC 

L537 

sxc 

C«2.4 

LXA 

L475.4 

L5je 

FMP 

C  +  1 

FAC 

L544 .4 

L53C 

LHS 

35 

TIX 

Le26.4.1 

FMP 

C 

LXC 

C  +  2.4 

TRA 

2.4 

L5i5 

CLA 

C 

TRA 

1  .4 

L537 

DEC 

2.6C21E-06 

L5A0 

DEC 

-1.9e08E-04 

L54  1 

DEC 

e.3330455E-03 

L5^2 

DEC 

-.  166666568 

L543 

DEC 

1.0 

LE44 

0CT 

2COCC0O0COOO 

L54b 

0CT 

2C1COOOO0O0O 

L546 

DEC 

1.57079632679 

ELNT3300 
ELNT3310 
ELNT3320 
ELNT3330 
ELNT334C 
ELNT3350 
eLNT3360 
ELNT3370 
ELNT33e0 
ELNT3390 
ELNT3400 
ELNT3410 
ELNT3420 
ELNT3430 
ELNT3440 
ELNT3450 
ELNT3460 
ELNT3470 
ELNT34e0 
ELNT3490 
ELNT3500 
ELNT3510 
ELNT3520 
ELNT353C 
ELNT354C 
ELNT3550 
ELNT3560 
ELNT3570 
ELNT3580 
ELNT3590 
ELNT3600 
ELNT3eiO 
ELNT3620 
ELNT3630 
ELNT3e40 
ELNT3650 
ELNT3660 
ELNT3670 
ELNT3680 
ELNT369C 
ELNT3700 
ELNT3710 
EL  NT  3720 
ELNT3730 
ELNT374C 
ELNT3750 
ELNT3760 
EL  NT  3  7  70 
ELNT3780 
ELNT3790 
ELNT3e00 
ELNT3810 
ELNT3820 
ELNT3830 
ELNT3e40 
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LBCl 

1  /I 

L6e3 

b'-.t 

rxi 

UBbt) 

hXI 

CL* 

•lUrl 
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EL  NT  3H50 
ELNT  JflftO 
fLNT  1670 

ELNT  )eao 

ELNT3890 
ELNI 3S00 
ELM  JQIO 

ELNf  i-jao 

ELNT3430 
ELNI3S40 
ELNr  J<3S0 
ELNT  3<;60 
ELNT  3';70 
FLNI  3<eo 
tLNi  i<;yo 

ELNTACOO 
ELNIAC 10 
ELNf«C?0 
CLNIAO JO 
fcLNI AC AC 
ELNT A05O 
ELNTAC60 
FLNTAO/O 
ELNIACHO 
ELNT  AOO 
ELNT A  100 
tLNTAl 10 
ELNT A  120 
ELNI A130 
FLNI A  1  AC 
FLNT  A  1">0 
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Solution  of  Systerna  of  Linear  Equations 

1.  LEQl   Solution  of  Linear  Equations  -  PAP  Coded 

2.  LEQ3   Solution  of  Linear  Equations  -  FORTRAN  Coded 

5.   LEQ2   Double  Precision  Solution  of  Linear 
Equations  -  FORTRAN  Coded 
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Identification:   LEQl-  Linear  Equations  Solution 
PAP  Coded  -  70 90 

Purpose:   To  solve  the  matrix  equation 
AX  =  B 
and  to  evaluate  the  determinant  of  A. 

Method:    The  Gauss  elimination  method  Is  used.   The 

matrices  are  normalized  row-wise  by  dividing 
by  the  largest  element  of  A{I,J)  In  that  row, 
then  the  A  matrix  Is  reduced  to  triangular  form 
by  (N-1)  transformations  using  a  pivotal 
condensation  process  after  which  X(I,K)  is 
computed  by  a  back-substitution  process. 
This  transforms  B  into  X  and  leaves  the 
product  of  the  diagonal  elements  as  the 
determinant  of  A. 

Input :    This  routine  assumes  the  coder  has  stored  the 
N  X  N  matrix  A  and  the  N  x  M  matrix  B  in  core 
the  way  FORTRAN  does,  that  is,  in  order  of 
decreasing  absolute  location.   A  2-dlmenslonal 
array  A  should  be  stored  sequentially  as 

^11^^21^ . . '^a^i^a^2'^22' '  "^^n2' •'•'^nn' 
where  the  first  subscript  is  the  row  index 

and  the  second  subscript  is  the  column  index; 

similarly  for  B. 
Usage:    The  routine  has  two  entries  which  are  synonymous. 
CALL  LEQ(A,B,N,M,IA,IB,DET) 
CALL  LEQD{A,B,N,M,IA,IB,DET) 

The  symbols  shown  as  arg'oments  represent  the 

following  variables: 

A:        a  2-dimensional  array  with  dimension 
(IA,IX)  and  specified  in  the 
DIIVGNSI0N  statement.   That  Is,  the 
dimension  of  A  may  be  greater  than 
or  equal  to  the  size  of  the  square 
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system  to  be  solved.   lA  supplies  the  information 
as  to  where  a-,^  is  in  relation  to  a,  ^  ,  etc. 
As  an  argument,  it  may  be  given  as  an  integer 
variable.   IX  is  not  required  as  an  argument. 
B:  a  one-  or  two-dimensional  array  with  dimension 
(IB,IY);  and  IB  and  lY  are  fixed  point  integers 
specified  in  the  DIMENSION  statement  such  that 
IB  >  N  and  lY  >  M.   lY  is  not  required  as  an 
argument.   If  lY  =  1,  the  one-dimensional 
format  for  arrays  is  acceptable.   As  an  argument, 
IB  may  be  given  as  an  integer  variable. 
N:  the  number  of  equations  and  unknowns. 
M:  the  number  of  vector  solutions  desired. 
IA,IB:  are  defined  with  A  and  B  respectively. 
DET:  the  name  of  the  variable  where  the  value   of 
the  determinant  will  be  stored.   Overflow  and/or 
underflow  conditions  resulting  from  the  calcula- 
tion of  the  determinant  will  not  terminate  execution 
of  the  program.   If  the  result  of  calculating  the 
determinant  is  an  overflow  condition,  the  routine 
will  return 

3777777777778  =  .17014ii8E39 
as  the  value  of  the  determinant.   If  the  result 
is  an  underflow  condition,  zero  will  be  returned 
as  the  value  of  the  determ.inant . 

Output:    The  elements  of  the  solution  matrix  X  are  stored 
in  bCI,K) 

where     I  =  1,2, . . .,N 
and       K  =  1,2, . . .,M. 

Note:      The  original  A  and  B  matrices  are  destroyed;  hence, 
they  should  be  saved  if  the  coder  desires  to  use 
them  after  using  this   routine » 

Accuracy:  (a)  The  "ill-conditioned"  Hilbert  matrix  H^  with 
elements  h.  .  =  (l+j-l)~  ,  l,j  =  l,2,.,.,n,  whose 
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true  inverse  is  known,   imposes  a  severe  test 
upon  any  inversion  routine.   This  matrix  was 
tested  with  the  following  results: 

Accuracy  of  Inverse 
about  5  sig.  figures 
about  4  sig .  figures 
about  3  sig.  figures 
max.  error  in  any  term 
about  6  per  cent . 
(b)  Tb': invert  the  Gamma  matrix: 


J. 


n 

Determinant 

4 
5 
6 
7 

1.65  X  10"'^ 
3.75  X  10"^2 
5.37  X  10"^^ 
4.84  X  10'25 

*ij 

=  *ji 

=  - 

l(n+l- 
n+1 

lii ,  1^ 

for  N  =  20 

Time: 

.6  sec. 

N  =  40 

4.8  sec. 

N  =  60 

17.4  sec. 

N  =  100 

1 

min. 

18.6  sec. 

Absolute  maximum  error 

(1)  along  the    (2)  along  the    (3)  along  the 
main  diag.       side  diag.       outside  diag. 

N=20  .35E-06[13,13]  .39E-06[13,12]  .l8E-06[5,9] 

N=4o  .83E-06[l8,l8]  .96e-o6[23,22]  .59E-o6[i6,8] 

N=60  .22E-05[30,50]  .24E-05[ 31,30]  .10E-05[36,17] 

N=100  .60E-05[60,60]  .60E-05[ 54,53]  .21E-05[26,53] 

Absolute  maximum  error  in  all  the  rows 

N  Row,  Col.  Error 

20  13   12  .39E-O6 

40  28   26  .llE-05 

60  31   30  .24E-05 

100       60   60      .60E-05 

"Contribution  to' the  Solution  of  Systems  of  Linear 
Equations  and  the  Determination  of  Eigenvalues," 
MBS,  Appl.  Math.  Series  _32^  105,  112  (1954). 
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Requirements : 

a)  Storage: 

323, Q  =  5033  locations . 
Author:   Max  Goldstein 
Date:  October  I961  (Revised  July  1964) 
Example:   Use  the  above  routine  to  find  and  print  the 

Inverse  of  a  3  x  5  matrix,  whose  elements 

are  l/Cl+j-1) . 

C  for  COMMENT 

Statement  No.  FORTRAN  STATEMENT 

C  S0LUTI0N  0F  LINEAR  EQUATI0NS  USING  F0RTRAN  AND  LEQ 

DIMENSI0N  H(60,60),  B(60,60) 
C  GENERATE  ELEMENTS  0F  H  MATRIX 

D0  1   I  =  1,3 

D0  1   J  =  1,1 

H(I,J)  =  1.O/PL0ATF(I+J-1) 

1  hCj,i)  =  H(I,J) 

C  GENERATE  IDENTITY  MATRIX  F0R  B 

D0  2  I  =  1,3 
D0  2  J  -  1,1 
IF  (I-J)  3.4,3 

3  B(I,J)  -  0.0 
B(J,I)  =  0.0 
G0  T0  2 

4  B(I,J)  -  1.0 

2  G0NTINUE 

C  DEFINITI0NS  BEF0RE  ENTRANCE  TO  LEQ 

N  =  3 

M  =  3 

lA  =  60 

IB  =  60 
C  ENTRANCE  T0  LEQ 

CALL  LEQ  (H,B,N,M,IA,IB,DET) 
C         RESULTS  ARE  ST0RED  0VER  0RIGINAL  B  MATRIX 

PRINT  10,  ((B(I,J),  J  -1,3),  I  =  1,3) 
10   F0RMAT  (IP3EI7.7) 
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LEGl  -  LINEAR  EOtJATmKS  SBLUTIBK  -  FAP  CBDEC 

132K  7394  LINEAR  EOLATIONS  SBLUTIBN  mTH  OETERMINAKT   NYU  MATH  LTILITV   LEQOOOIO 

>        NO  STANDARD  ERR0R  LE000020 

FAP  LEO00030 

I32K  7394  LINEAR  EOUATIBNS  SBLUTIBN  •ITh  DETERMINANT   NYU  MATH  LTILITY   LEQ00040 

PCC  LEOOOOSO 

L6L       LEQ.q  LEQ00060 

1  THIS  VERSION  D0ES  SPECIAL  THINGS  FBR  € VER-UNDEHFLBW  ATOE TERM  I N ANT  CALCLEQ00070 

LEooooao 

LEQ0CC90 

FL0LEOOO1OO 

FLaLEOOOl 10 

LEO00120 

evER-LNDEBFLBW  CBUNTER  FL0LEQOOJ3O 

LE000140 

SET  UP  A(  1  .  1  )  LEQOOISO 

LEQ00160 

SET  VP    6(1. n  LE000170 

LEQOOieO 
LEQ0019C 
LEQ00200 
LEQ00210 
LEQ00220 
LEQ00230 
LEQ00240 
LEaO02SO 
LEaO0260 
LEQ00270 

lA  STeREC  IN  ADDR.  LEQ002eO 

SET  LP  IE  LEQ00290 

LE000300 
LEQ00310 
LEQ00320 
LEQ00330 
LE000340 
LEOOO350 
LEQ00360 

le  STBREO  IN  ADDRESS  LEQ00370 

N  LEQ003eO 

LEQ00390 
LE000400 
LE000410 

N-1  LEQ00420 

LEQ00430 
LE000440 

M  LE000450 

LEQ00460 
LEQ0047C 

i.o  re  CET  LEooo4eo 

LEQ00490 
LE000500 
LEQ00510 
NBRMALIZE  MATRIX  ELEMENTS  LE000520 

(N-l)Te  X4.  0  T0  XI  LEQ00530 

lA  TB  X2  LEO00;4C 

CLEAR  ACC.  LEQ00550 
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ENTRY 

LEQ 

ENTRY 

LEQD 

SXA 

BACK+1.1 

SXA 

BACK+2.2 

SXO 

X4  .4 

STZ 

CNT0 

CLA 

1  .4 

STA 

A 

CLA 

2.4 

STA 

H 

STA 

D*2 

STA 

B2 

STA 

H2-f2 

CLA» 

5  ,4 

STC 

lA 

STD 

IA+1 

STD 

IA2 

STD 

IA3 

STC 

IA4 

ARS 

le 

STB 

C0MM0l^(-4 

CLA« 

6.4 

STC 

IH 

STC 

IB*  I 

STC 

lea 

STD 

IB3 

STC 

IB4 

STD 

IBS 

ARS 

18 

STB 

CBMMBN-5 

CLA« 

3  .4 

AHS 

le 

STB 

C0NST*1 

STB 

C0MM0N 

sue 

CeNST*2 

SLW 

C0MM0N-1 

STA 

C0NST*3 

CLA. 

4  ,4 

ARS 

IE 

STB 

CBMMBN-a 

CLA 

C0NST 

STB 

C0MM0N-e 

CLS 

A 

TRA 

SET 

LXA 

C0WM0N-1 . 

LXD 

C0NST+2.1 

LXA 

C0MM0N-4. 

ADM 

0  .  1 

SBM 

0.2 

TPL 

IA3 

SXD 

C0NST*3,2 

LXD 

C0NST+3.1 

TXI 

•♦I .2.0 

T  IX 

CLEAR. 4.1 

CLA 

8 

STB 

H0LD 

CLA 

FPTR 

ST0 

e 

LCO 

0.  1 

STQ 

C0f M0N-2 

FMP 

C0^'^'0N-6 

ST0 

Ca»'K0N-6 

CLA 

H0LO 

ST0 

e 

LXD 

C0NSTt2.1 

LXA 

C0WM0N.A 

LXA 

C0MM0N-3.2 

CLA 

0  .  1 

FOP 

C0^/M0N-2 

STO 

C.  1 

TXI 

•  ♦1.1 

TIX 

A4  .4  .  1 

LXD 

C0NST*2.l 

CLA 

C.  1 

FDP 

C0MM0N-2 

STG 

0  .  1 

TXI 

•♦1.1 

TIX 

62.2.1 

CLA 

ceNST+i 

sue 

C0NST+? 

Tze 

PTF 

ST0 

C0NST+1 

CLA 

B2 

sue 

C0NSTt2 

STA 

82 

STA 

B2  +  2 

CLA 

A2 

sue 

C0NST*2 

STA 

A2 

STA 

A2+1 

STA 

A30 

STA 

A4 

STA 

A4*2 

THA 

N0RM 

CLS 

A 

LXA 

C0MM0N.4 

TXL 

EXIT. 4. 1 

TRA 

TF0RM*3 

CLS 

A 

sue 

C0MM0N-4 

SUB 

C0NST*2 

STA 

A-1 

LINEAR  EQUATI0KS  SRUUTIBN  -  FAP  CBOEC 


A(I.l)   IN  ACORESS  LEQ00S60 

CITT0  LEQ00570 

LEQOOSeO 

LEO00S90 

LE000600 

lA  IK  OeCREVENT  LEQ00610 

LEO00620 
TTR  TB  FFT  FL0LEQOOe3O 

FL0LEOOO64O 

A  TRA  T0  TEST0  SECTI0N  0F  LEG       FL0LEQOO65O 

»ILL  G0  TB  TEST0  0N  0 VER-UNCERFLBW     LEQ00660 

A(I.l)   IN  ADDRESS  LE000670 

►lAXIKUM  R0M  ELEMENT  LEOOOCeO 

LEOOOeQO 
EVALUATE   DET  LE000700 

FL0LEQOO71O 
FLflLE000720 
C  T0  XI  LEQ00730 

N  T0  X4  LEQ00740 

K  T0  X2  'LEQ00750 

A(I,1)   IN  ADDRESS  LE000760 

HAXlfVI*     R0W  ELEMENT  LEQ00770 

A(l.l)   IN  ADDRESS  LEQ007eO 

lA  IN  DECREMENT  LE000790 

LEOOOeOO 
LEOOOeiO 
E(I,1)   IN  ADDRESS  LEQO0e20 

MAX.  R0M  ELEMENT  LEQ00830 

e(I.l)   IN  ADDRESS  LEOOOe40 

IB  IN  DECREMENT  LE000850 

LEOooeeo 

NBRMALI ZAT IBN    ENDS     0N  LE000e70 

2ER0     TRANSFER  LEOOOeeO 

IS  N  N0»i  1  LEQOoegc 

LEQ0C9O0 
LE000910 
LE000920 

SET  LP  B(  I  .  1  )  LEQOO'330 

LEO0C940 
LE000950 
LE000960 

SET  LP  A(  I  .  1  )  LEQ00970 

Leooo9ao 

FLB     FL0     FLB  LEQ00990 

LEQOICOO 
LEQOIOIC 
LE001G2C 
LEQOI030 
LE00104C 
LE001C50 
LEQO 1060 
START  TRANSF0RMAT  IBN  LEOOI070 

LEOOlOeO 

LEO01C90 

SET  LP  TEMFBRARY  ADDRESSES  LEOOllOO 


LEGl  -  LINEAR  FGtATIBNS  SBLUTieh  -  FAP  CBCEC 


STA 

STA 

Ae  f  1 

blA 

Af +2 

STA 

Aet3 

bTA 

STA 

STA 

Ae  +  2 

SUR 

C»NSTt2 

STA 

A9 

STA 

H2*l 

STA 

U3  +  2 

STA 

U2*2 

STA 

H4 

sue 

CMNST*2 

STA 

f)'>*2 

STA 

643 

LXC 

C«NST*2, 

LXA 

CHNSTt2, 

LXA 

CH^MB'^l-l 

CMFRE 

PXD 

C 

ACW 

0.  1 

A 

SDM 

C.2 

TPL 

Cf-PReta 

SXD 

C0NET4-3. 

LXC 

C0NSTt3. 

TX  I 

• t 1 .2. 1 

TIX 

CMPRf.A. 

FMP 

,   C«yM0N-e 

STB 

C0f M0N-6 

CLA 

H«LC 

STa 

e 

TXL 

T,  1.0 

CLS 

ca^'^'0N-6 

ST« 

c(!^'^0N-e 

LXA 

C0WM0N.A 

LXC 

C0NSTt2., 

3XC 

C0NSTt3. 

CLA 

C  .  1 

LUO 

0.2 

ST« 

C.2 

STC 

0.  1 

TX  1 

•♦1.1 

Fen  A ( I . I )  LEoo 1 1 10 

FL  0     FLe     FL0  LEQ01120 

LEGO  1  130 
LEGO  1 140 
LEQOl 150 
LEQOl 160 
LEC01170 
LECOlieO 
LEQOl 190 
UEQ0I200 
SET  LF  Feo  A(I.I)-1  LE001210 

I.E001220 

LEQ0123C 

e(N.l)  LE00124C 

♦K-l  LE00I2S0 

LE001260 
LEQ01270 
LEO012e0 
LEaOI290 
LE001200 
-I  LE001310 

LE001320 

LEQ01330 

C  T0  XA  LEQ0I34C 

1  T0  XB  LE0013S0 

S-1   Te  XC  LE001360 

ce^'PARe  leooi37o 

A(I,I)   IN  ACCRESS  LE0013eO 

A(I.I)   IN  ACCRESS  LEQ0139C 

LE001400 
FIKO  LARGEST  ELEMENT  IK  fi0W        LE0014IO 

LE001420 

LE001430 

LEQ0144C 

=1  T0  FFT  FL0LEOOI45O 

FLaLEQ01460 

T  FL0LEQO147O 

LL  70  T(!  TfcSTe  KN  0  VE  R-U  N  D  E  RF  L  0  W     LEQ014eO 

A(I.I)   IN  ACCRESS  LEOOI490 

+  LEOOISOO 

CETEKMNAM  LEOOISIO 

FL0LEQO152O 

FL0LEOO153O 

CENT  SWAP  IF  XI   IS  ZER0  LEQ01540 

CHANGE  SIGN  BF  DET.  LEQ01550 

LE001560 
N(  I  )    T0    X   tt  LEOOi;70 

C  T0  X  2  LE001580 

SAVE   XI  LEOOISSO 

S*AP  A  Rev«S  LEQ01600 

A(I.I)   IN  ACCRESS  LEQOieiO 

CITTR  LEa01620 

CITTK  LEO01630 

lA  IN  DECREMENT  LEQ0164C 

lA  IN  DECREMENT  LEQ01650 


LINEAR     eQt*TI0NS     SeLUTief 


FAP  C0CEC 


CLA 

C.  1 

LDG 

0.2 

STe 

C,2 

STG 

C.  1 

TXI 

•tl  .  I 

TXI 

•♦1.2 

TIX 

B3.4. 1 

LXA 

C0>'r'0M-i  .4 

LXO 

C1?NST+2.1 

CLS 

0.1 

TZE 

IB2  +  2 

FOP 

0 

STC 

CUfl'eH-2 

LXA 

C0yM0M-l , 2 

TXI 

•  +  1.  1 

CLA 

C  .  1 

IZE 

Aes-f  I 

LCQ 

0.  1 

FMP 

C(^^/^'0M-2 

FAC 

C,  1 

FRN 

ST0 

0.  1 

TIX 

IA2.2. 1 

LXA 

C0^W0M-2,2 

TXL 

IB2*2.2.0 

LXC 

C0NSTt2.1 

LCQ 

0.  1 

FVP 

C0^'^'0^l-^ 

FAD 

0,  I 

F«N 

STK 

0.  1 

TX  I 

•  +  I  .  1 

T  IX 

B4.2.1 

TIX 

•  +  2.4. I 

TRA 

REDLC 

CLA 

AES 

sue 

C0NST»2 

ST» 

A9 

STA 

Ae  +  4 

STA 

AgS 

CLA 

fi4*2 

SLe 

C0NST+2 

H     T0  X4 

^=0   .  00  OET  eKLY 

C  T0  X2 

BESTBRE  XI 

S*AP  e 

E(I.l)   IN  ACDRESS 

CITT0 

CITte 

IB  It  DECREMENT 

le  IN  DECREMENT 

e  R0»  SWAP  FINISHED 

TRANSFBRy  A  ELEMENTS 

A (  I  ,  I  )-l   IN  ADDRESS 

A(  1  ,  I  )   IN  ADDRESS 


lA  IN  OECREVENT 
A ( I , I )   IN  ADDRESS 

A ( I . I )   IN  ADDRESS 

A( I , I )-l   IN  ADDRESS 

C  I  TTe 

De  NEXT  C0LLCN 

TKANSFBRy  e  ELEMENTS 

M=0,   00  DET  0NL1 
C  T0  XI 
e(  I  .  1  )   IN  ADDRESS 


RECLC  CLA 

sue 


ceMW0N 

C0NST< 


IB  IN  DECREMENT 


ALL  B0WS  FINISHED 
D0  NEXT  Re* 


Te  oe   NEXT  Re» 

REDUCE  NCI) 


N  (  I  )  -  1 

REDUCE  TRANSFBRMATI  KN  C01. 


LEQ01660 
LEQ01670 
LEQOieeO 
LEQ01690 
LEQ01700 
LE001710 
LE001720 
LEQ01730 
LEQ0174C 
LEQ01750 
LEQ01760 
LEQ01770 
LEQ017eO 
LEQ01790 
LEQ01800 
LE001810 
LEQ01820 
LEQ01830 
LEGO 184C 
LEOOieSO 
LEQ01860 
LEQ01870 
LEQOie80 
LEQ0189C 
LEQ01900 
LEQ01910 
LEQ01920 
LE001930 
LE00194C 
LEQ019S0 
LEQ01960 
LEQ01970 
LEQ0l9e0 
LE001990 
LEQ02000 
LEQ0201C 
LEQ02020 
LEQ02030 
LE002040 
LEQ020S0 
LEQ02060 
LE002070 
LEOO20e0 
LE00209C 
LEQ02100 
LEQ02110 
LE002120 
LE002130 
LEQ0214C 
LE002150 
LEQ02160 
LEQ02170 
LEQ02180 
Le002190 
LE002200 


ST0 

CK^'^'0N-l 

TNZ 

TF0BM 

CLA 

A9 

SUB 

C0f yaN-4 

STa 

H0LC 

CLA 

FPTR 

ST0 

e 

FLIi 

LCO 

0 

FMP 

C0VM0N-6 

i,T0 

C0yM0N-e 

CLA 

H0LO 

ST0 

8 

CLA 

C0KM0N-3 

TZE 

EXIT 

NEXT 

CLA 

C0NST4-3 

ACC 

b+  1 

STA 

A  10 

CLA 

B2 

STA 

B6 

ACC 

C0NST+2 

STA 

62 

CLA 

B 

STA 

05 

STA 

B51 

LXA 

C0NST+3,3 

LXA 

CaKM0l>l-3,* 

B 

CLA 

0.2 

FCP 

0 

STQ 

0,2 

IB3 

TXI 

•♦1.2 

TIX 

Q  .4.  1 

TXL 

EXIT. I .0 

S0LVE 

LXC 

C0NSTt2.2 

LXA 

C0yM0N-3.4 

86 

LOO 

0  .2 

AlC 

FMP 
CHS 

0 

B5 

FAC 
FRN 

C.2 

651 

ST0 

0.2 

164 

TXI 

•♦1.2 

TIX 

B6.0.1 

CLA 

A  10 

SUB 

C0NST+2 

ST0 

AlO 

CLA 

R5 

sue 

CeNST+2 

STA 

es 

STA 

851 

TIX 

S0LVE.1 .1 

CLA 

R+  1 

ACC 

C0MM0N-4 

LINEAR  eOUATiesS  SeLUTIKN  -  FAF  CBOEC 


(FR0K  N  Te  1)  LE002210 

NKT  ZER0  00  NEXT  TRANSFBBM  LE002220 

LeQ02230 

LE002240 

FL0LEQO225O 

LEQ02260 

TTR    T0  FPT  FLaLE002270 

FL0LEQO22eO 

TBA  la  SeCTIBN  IN  LEO  F0R  0 VE B/UNDRFL0LEQO 2 290 

HILL  G0  Te  TESTB  0N  0 VER-UN DERFL 0*     LE002300 

A(NN)  LEQ02310 

LEQ02320 

OETEB»'INAKT  LE002330 

FL0LEQO234C 

FL0LEQO235O 

LEQ02360 

EXIT  IF  V  ZER0  LEQ02370 

SET  LF  A(I.N)  LE0023eO 

LE002390 

LEQ02AOO 

e(N.l)  LEQ02A10 

LE002420 
LEQ02430 
LEQ0244C 
LEQ024S0 
LE002460 
LEQ02470 
LEQ02480 
LEQ02490 
LEQ02E00 
LEQ0251C 
LE002520 
LEQ02530 
LEQ02S4C 
NE  LE002550 
LEQ02S60 
LE002570 
LEQ02580 
LEQ02590 
LE002600 
LEQ02610 
LE002620 
LE002630 
LE00264C 
LE002650 
Ce  NEXT  RBh  LE002660 

LE002670 
LE0C26e0 
LE002690 
LE002700 
LEQ02710 
LEQ02720 
LE002730 
LEQ0274C 
LE002750 


h-l      T0 

XI 

AND  X2 

K  T0  X4 

e(  1 . 1 ) 

IN 

ACCRESS 

A(  t  .1  ) 

6(1.1  ) 

IN 

ACDRESS 

IB  IK  0 

ECREMENT 

EXIT  IF 

XI 

I  ZER0.  ALL 

R0I 

0  T0  X2 

K     T0  X4 

S0LVE  .BIN, 

,  I  )   IN  ACCRESS 

A(I  .K> 

IN 

ACCRESS 

6(1.1) 

IN 

ADDRESS 

6(1.1) 

IN 

ADDRESS 

IB    IN 

DECREMENT 
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CLA 

C0N 

SLB 

CUN 

sTia 

CHN 

TRA 

NEX 

LCG 

=  C 

CLA 

CNT 

TZE 

BACI 

STB 

LAST 

CLA 

0 

ARS 

iq 

LBT 

TRA 

SETCT 

AHS 

1 

5UB 

=  1 

ST0 

CNT0 

CLA 

LAST 

CNT0 

PZE 

CKNST 

DEC 

UCT 

0CT 

0CT 

LECD 

SYN 

STUHE 

BfcS 

iLAST 

P7E 

:0ii'N  0N 

SYN 

XA 

SYN 

LAST 

PZE 

vIEAR  EQLATI0NS  SeLUTieS  -  FAR  C0OEC 


LEQ02760 

LEQ02770 

LEQ027eO 

LE002790 

LeQ02e00 

LEQ02eiO 

FL0LEQO2e2O 

FL0LeQO2e3O 

FL0LEQO2e4C 

»+2  FL0LEQO2e5O 

=0377777777777       MgRE  evEHFL0*S  THAN  UNDERFL0KS       FL0LEOO2e6O 
CaCMgN-e  FL  LEQ02e70 

0  FL0LeQO2e8O 

0.1  LEQ02egO 

0.2  LEQ02900 

XA.ii  LEQ02910 

C0^'MC^N-e  fl0LEQO292O 

7.i,  AND  EXIT  LEQ02g30 

e,H  LEQ02940 

LE002950 
C0NTENTS  0F  ACCi:fULAT0R  FL0LeOO296O 

FL0LEQO297O 
L00K  AT  BIT  16.   fEANS  AC  INV0LVED.  FL0LEQO298O 

FL0LEQO299O 

AC  N0T  INVKLVEC  HEBE.  SKIP  CNT0  FABT.         LEQ03000 

L00K  AT  (!VEBFL0Vt  BIT.  FU0LEQO3O1O 

TEST  FgR  0VER  BR  L)NCERFL0X(  FL0LeOO3O2O 

FL0LEQO3O3O 
F0R  0VERFLev»  ACQ  A  0NE  T0  CNT0  FL0LEQO3O4O 

FL0LEQO3O5O 

FL0LEQO3O6O 

F0R  UNDERFL0W  SUBTRACT  A  0NE  FRBM  CNT0  FL0LEOO3O7O 

FL0LEQO3O8O 

FL0LEQO3O9O 

RESTKRE  ACC  FL0LEQO31OO 

AND  RETURN  Te  L0C  +  1   0F  0  VER/UNDE  RFL  0IK  LEQ03U0 

LEQ03120 

FL0LEQO313O 

FL0LEQO314C 

0\<ERFLe»i/LNDERFLew     C0UNTER  FL0LEQO315O 

LE003160 

OCOCOIOOCOOO  LEQ03170 

CCOCOOOCOOOl  LEQ03180 

C  LEQ03190 

LtO  FL0LEQO32OO 

H  FL0LEOO321O 

0  RESERVE  A  PLACE  F0R  THE  SYMG0L  CHUIAZN  FL0LEQO322O 

i,T0RE  FL0LEQO323O 

CKMM0N)-7  LE003240 

0  FL0LEOO325O 

LEQ03260 


1  .0 
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Identification:   LEQ5  -  Solution  of  Linear  Equations 

FORTRAN  II  Coded  -  70 90 
Purpose:   To  find  the  solution  of  the  matrix  equation 
AX  =  B 
and  to  evaluate  the  determinant  of  A. 
Method:   Same  as  that  of  the  PAP  version  of  LEQ. 
Usage:     Same  as  that  of  the  PAP  version  of  LEQ  with 
the  following  exceptions: 

a)  There  Is  no  entry  point  LEQP 

b)  The  determinant  of  A  is  always  computed 
but  no  check  is  made  for  overflows  and 
underflows.   Execution  is  terminated  on 
an  overflow. 

c)  The  dimension  statement  in  the  subroutine 
is 

DIMENSI0NA(6O,6O),  B(60,6o) 
This  statement  should  be  changed  If  different 
dimensions  are  desired. 
Requirements : 

a)  System  Built-in  Functions 
ABS 

b)  Storage 

570-j_Q  =  1072g  locations 
Author:   N.  Stutz 
Date:   January  I965 
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LEQ3  -  LINEAR  EQUATI0KS  SELUTIBN  -  FBRTRAN  II  CBDEO 

CLEC   LINEAR  EOLATI0NS  S0LLTI0NS   FgRTRAN  II  VERSIKN                          LEQFCOIO 

SUeR0OTINE  LEG( A .B.NEQS.NSeLNS , I  A ,  IB.CET)  LEQF0020 

C       S0LVE  A  SYSTEM  0F  LINEAR  EQLA1I0NS  0F  THE  FBR^  AX=B  BY  A  N0DIFIEC  LE0F0030 

C       GAUSS  ELIMINATI0N  SCHEME  LEQF004C 

C  LEQF0050 

C       NEQS  =  NUMBER  0F  EQUATI0NS  AND  UNKN0K.NS  LEQF0060 

C       NS0LNS  =  NUMBER  0F  VECT0R  SeLLTI0NS  DESIRED                              LEQF0070 

C        lA  =  NUMBER  0F  R0WS  0F  A  AS  DEFINED  BY  DIMENSIZN  STATEMENT  ENTRY   LEOF0080 

C       ID  =  NUMBEH  0F  R0V»S  0F  B  AS  DEFINED  BY  DIMENSION  STATEMENT  ENTRY   LEQFCC90 

C       ADET  =  DETERMINANT  0F  A,  AFTER  EXIT  FRgM  LEC                             LEQFOIOO 

C  LEOFOllO 

DIMENSI0N  A( e0.60) .B(60.6C)  LEQF0120 

NSIZ  =  NEQS  LEQF0130 

NBSIZ  =  NS0LNS  LECF0I4C 

C       NORMALIZE  EACH  R0»  BY  ITS  LARGEST  FLEf'ENT.  FBRM  PARTIAL  DETEPNT     LEQF0150 

DET=l.C  LEOFOieO 

Dk)  I   1  =  1. NSIZ  LEOF0170 

B1G=A( 1,1)  LEGF0180 

IF( NSIZ- 1 )50.50.51  LEOF0190 

ei  C0  Z  J=2,NSI2  LEQFC200 

IF( ABSF(BIG)-ABSF ( A(  I  , J)  )  )  3.2,2  LEQFC210 

3  BIG=A( I, J)  LEQF0220 
2      C0NTINUE  LEQF0230 

D0  t     J=1,NSIZ  LE0F024C 

1               A( I , J )=A( I , J )/aiG  LEQF0250 

D0  41   J=1,NBSIZ  LEQF0260 

4  1     B(  I  . J  )=B(  I  . J )/BIG  LEQF0270 

DtT=DET»OIG  LEQF02eC 

1      Ca'JTINLE  LEQF029C 

C       START  SYSTEM  REDLCTI0N  LEOF0300 

NUMSYS  =  NSIZ- 1  LEOF0310 

D0  14   I=l.NUySYS  LE0F0320 

C       SCAN  FIRST  C0LUMN  0F  CURRENT  SYSTEf  FgR  LARGEST  ELEMENT               LEQF0330 

C       CALL  THE  R0W  C0NTAIMNG  THIS  ELEMENT.  R0W  NBGR*  LEQF034C 

NN=I+1  LEQF0350 

BIG  =  A(  I  .  I)  LeOF0360 

NH&RW=I  LEQF0370 

D0  t     J=NN,NSIZ  LEQF0380 

1F( ARSF(BIG)-ABSF( A( J. I ) ) )  6. =.5  LEOF0390 

6  HIG=A( J.I)  LEOF0400 
NBGR*=J  LEOF0410 

5  C0NTINUE  LEOF0420 
C       SwAP  R0W  I  WITH  R0*  NBGRVH  UNLESS  I=NBGR*il  LE0F0430 

IF(NBGRW-I)   7.10.7  LEQF044C 

C       SWAP  A-MATRIX  R0»S  LEQF0450 

7  D0  e  J=I.NSIZ  LEOF04eO 
TEMP=A(NBGRw, J )  LEOF0470 
A( NBGRW. J )=A( I . J )  LEQF04eO 

8  A(I,J)=TEMP  LEQF0490 
DEI  =  -DET  LEQFOSOO 

C       SWAP  U-MAIRIX  R0»S  LEOF0510 

D0  9  J=1.NBSIZ  LEOFC520 

TEMP=B(NBGR*. J)  LEQFC530 

B(NeGR». J ) =B( I . J)  LEQF054C 

9  0(I.J)=TEMP  LEQF0550 
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LEQ3  -  LINEAR  EOUATI0NS  SBUjTieN  -  FeRTRAN  II  C0CEC 

C       ELIMINATE  UNKNOWNS  FR0M  FIRST  CBLLf'N  gF    CURRENT  SYSTEM  LEOFCS60 

ir     D0  13  K=NN,NSIZ  LeOF0570 

C       C0MPUTE  PIV0TAL  MULTIPLIER  LEOFOSeO 

PMULT=-A(K, I )/A( I , I )  LeOFC590 

C       APPLY  PMULT  T0  ALL  C0LUMNS  BF  THE  CURRENT  A-KATRIX  REM                LEOF0600 

00  11  J=NN,NSIZ  LEOF0610 

11  A(K, J )=PMULT»A(  I , J  )»A(K. J  )  LEOF0620 
C       APPLY  PMULT  T0  ALL  C0LUMNS  0F  MATHIX  E                                     LEQFC630 

00  12  L=l.NBSIZ  LEOF0640 

12  B(K,L)=PMULT«B(  I ,L  )+e(K,L  )  LE0F0650 

13  C0NTINue  LeOF0660 
lA     C0NTUJLE  LEQF0670 

C       00  BACK  SLBSTITUTIBN  LEQFOeeO 

C       milh     B-MATHIX  C0LUMN  =  NC0L8                                                 LE0F0e90 

50  00  15  NC0LB=1 .NBSI Z  LEQF0700 

C       C0  F0R  R0*  =  NR0W  LEOF0710 

00  19  1=1.SSIZ  LE0F0720 

NR(«»  =  NSIZ*1-I  LECF0730 

TEMP^O.O  LE0F074C 

C       NUMeEH  0F  PREVI0LSLY  C0MPLTED  UNKK0*NS  =  NXS                             LEQF0750 

NXS  =  NSIZ-NR01»  LEOF0760 

C       ARE  *E  C0ING  THE  B0TT0M  Rli*  LEOF0770 

IF(NXS)   16.17.16  LE0F07eC 

C       N0  LEQF0790 

16  00  le  K=1,NXS  LEQFOeOO 
KK=NSIZ+1-K  LEOFOeiO 

18  TtMP  =  TEMP*8(KK.NC0LB)*A(NHe*i,KK)  LEOF0e20 

17  e(NR0*.NC0LB)  =(8(NR0»».NC0Le)-TEMP)/A(NR0»,NRei«)  LEOFOBSO 
C       HAVE  *»E  FINISHED  ALL  W0*S  F0R  B-MATRIX  CBLUMN  =  NC0L8  LEOFOBAC 

19  C0NTINUE  LEQFOeSO 
C       YES  LEOFOeeC 

S  KCflLB=NSIZ  LEOF0870 

LEOFOeSO 
LEOFOe90 
LE0FO90C 
LEOF0910 
LEOF0920 
LECF0930 
LE0F094C 
LEQF0950 
LEQF0960 
LEQF0970 


C 

HAVE  WE     JUST  FINISHED  WITH  B-^ATRIX  i 

15 

C0NT INUE 

C 

YhS 

C 

N0IK  FINISH  C0MPUTING  THE  DETERMINANT 

C0  20  I=1.NSIZ 

20 

OET=DFT»A( 1. I ) 

AOET  =  OET 

C 

WE  ARE  ALL  O0NE  N0W 

c 

WHEW... 

RETURN 

END 
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Identification:   LEQ2  -  Double  Precision  Linear  Equations 

Solution  -  FORTRAN  II  Coded  -  7090/9^ 

Purpose:   To  find  the  double  precision  solution  of  the 
matrix  equation 

AX  =  B 
and  to  evaluate  the  determinant  of  A. 

Method:    Same  as  that  of  the  FAP  version  of  LEQ,  except 
that  double  precision  arithmetic  Is  used. 

Input:     The  routine  assumes  that  the  coder  has  stored 
the  N  X  N  matrix  A  and  the  N  x  M  matrix  B  as 
FORTRAN  II  does.  I.e.,  with  the  low  order  parts 
of  all  the  elements  of  each  matrix  In  a  block 
of  core  storage  entirely  below  the  block  reserved 
for  high  order  parts.   The  ordering  within  each 
block  Is  the  same  as  that  of  a  single  precision 
array. 

Usage:     Same  as  that  of  LEQ  with  the  following  exceptions: 

a)  The  A  and  B  matrices  are  double  precision. 

b)  The  DIMBNSI0N  statement  now  In  the  LEQ2  symbolic 
deck  Is: 

D   DIMENSI0N  A(60,60),  B(60,60) 
(A  and  B  are,  of  course,  the  A  and  B  matrices.) 
If  these  dimensions  are  unsatisfactory,  the 
coder  must  replace  the  DIMENSION  statement. 
It  is  necessary  that  the  dimensions  of  A  and  B 
In  the  LEQ2  symbolic  deck  and  In  the  calling 
program  be  Identical. 

c)  In  order  to  avoid  computing  the  determinant, 
the  coder  should  remove  cards  LEQ20270, 
LEQ2090O,  LEQ209IO  from  the  symbolic  deck. 

Requirements : 

a)  System  Built-in  Functions  (open  subroutines) 
ABS 

b)  Storage 

850,Q  =   I522g   locations 


Hi 


Timing  and  Accuracy:   (see  also  write-up  of  LEQ) 


a)  Inversion 

of  Hllbert  matrix. 

h^.   =  (l+J-1)"^,    I, J  =  l,2,...,n 

n 

Accuracy  of  Inverse 

5 

>-  8  significant  figures 

6 

>   8  significant  figures 

7 

8  significant  figures 

8 

7  significant  figures 

9 

6  significant  figures 

10 

5  significant  figures 

b)  Inversion 

of  well-conditioned  matrix  ]~^   with 

elements  : 

v^.   =   r.^   =  l(n+l-j)/(n+l), 

1  < 

J,  1, 

j  =  1,2, ...,n. 

n 

Time  (7094)   Max.  error  In  any  term 

20 

3.0  sec.       <  0.1  E-13 

40 

23.4  sec.       <  0.1  E-15 

60 

1  I 

nln.  19.8  sec.       <  0.2  E-I3 

80 

5  I 

Tiln.   8.4  sec.       <  0,4  E-I3 

Author:   S.  Oc 

ken 

Date:   October 

1963 
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LEQ2  -  D0UeLE  PREC1SI0N  CINEAR  EOtATIBNS  S0LUTI0N  -  FaRTHAN  II  CBOEO 


CLEC2   D0UBLE  PReCISI0N  LINEAR  EOUATI0NS  S0LUTI0N   S.  0CKEN   0CT.,   1963  LEQ20010 

SUeR0UTlNELEQ2(A,B .NEQS.NSBLNS.IA.IBtADET)  LEQ20020 

C       S0LVE  A  SYSTEM  0F  LIMEAR  EaUATI0NS  0F  THE  F0BM  AX=B  BY  A  M0OtFIED  LE020030 

C       GAUSS  EL1MINATI0N  SCHEME  LEQ20040 

C  LEQ20050 

C       NEOS  =  NUMEEH  0F  EQUATI0NS  ANC  (JNKN0WNS  LEQ20060 

C       NS0LNS  =  NUMBER  0F  VECT0R  S0LI.TI0NS  DESIRED                              LE020070 

C       lA  =  NUMBER  0F  RZmS  0F  A  AS  DEFINED  BY  DIMENSI0N  STATEMENT  ENTRY   LEQ20080 

C       IB  =  NUMBER  0F  R0WS  0F  B  AS  DEFINED  BY  DIMENSION  STATEMENT  ENTRY   LEQ20090 

C       AOET  =  DETERMINANT  0F  A,  AFTER  EXIT  FHBM  LEG                             LEQ20100 

C  LEQ20110 

D       DIMENSION  A ( 6 0 . 80 ) .B ( 80 . 80 >  UEQ20120 

NSIZ  =  NEQS  LEQ20130 

NBSIZ  =  NS0LNS  LEQ20140 

C       N0BMALIZE  EACH  R0*  BY  ITS  LARGEST  ELEMENT.  F0RM  PARTIAL  OETEHNT     LEQ20150 

D       DET=1.0  LEQ20160 

00  1   1=1. NSIZ  LEQ20170 

D       BIG=A(I.l)  LEQ20180 

D0  2  J=2.NSIZ  LEQ20190 

IF( ABSF(BIG)-ABSF( A( I. J) ) )  3.2.2  LEQ20200 

D3      BIG=A(I.J)  LEQ20210 

2      CONTINUE  LEQ20220 

D0  4  J=1.NSIZ  LEQ20230 

C4      A(  I. J)=A(  I  ,J)/BIG  LEQ20240 

00  41  J=l. NBSIZ  LEQ20250 

04J     B(  I,J)=B(  I  .J)/BIG  LEQ20260 

D       OET=DET»BIC  LEQ20270 

1      CONTINUE  LEQ20280 

C       START  SYSTEM  REDUCTION  LEQ20290 

NUMSYS=NSIZ-l  LEQ20300 

D0  14  1=1.NUMSYS  LEQ20310 

C       SCAN  FIRST  COLUMN  0F  CURRENT  SYSTEM  F0R  LARGEST  ELEMENT               LEQ20320 

C       CALL  THE  R0*  CONTAINING  THIS  ELEMENT.  ROM  NBGRW  LE020330 

NN=I+1 
0       BIG=A( I.I ) 

NBGRW=I  LEQ20360 

00  5  J=NN.NSIZ  LEQ20370 

IF( ABSF(81G)-A85F( A( J. I  )  )  )  6. £.5  LEQ20380 

06      BIG=A(J.I)  LEQ20390 

NBGRW=J  LEQ20400 

5      CONTINUE  LeQ20410 

C       SWAP  ROW  I  WITH  ROM  NBGRM  UNLESS  I  =  NBGfi*(                                  LEQ20420 

IF(NBGRW-l)  7.10.7  LE020430 

C       SWAP  A-MATRIX  ROWS  LEQ20440 

J              DO  8  J=I,NSIZ  LEQ20450 

0       TeMP=A(NBGRW, J )  LEQ20460 

0       ACNGGRW, J)=A( I .J)  LEQ20470 

08  A(I,J)=TEMP 
O       DET  =  -DET 
C       SWAP  B-MATRIX  ROWS  LEQ20500 

00  g  J=l. NBSIZ  LEQ20510 

0       TEMP=B(NBGRW,J)  LEQ20520 
0       B(NBGRW. J)=Bl  I  .J) 

09  B( I, J)=TEMP 


LEQ2034C 
LEQ20350 


LEQ20480 
LEQ20490 


LEQ20530 
LEQ20540 


LEQ2  -  DBLiELE  PRECISI0N  LINEAR  EOLATI0NS  SaLLTIBN  -  F0RTR*N  II  C0OED 

C  ELIMINATE  tNKNeKNS  FR0M  FIRST  CBLLKN  0F  CURRENT  SYSTEM  LEQ20550 

10  00  13  K=NN,NSIZ  LEQ20560 

C  C0MPUTE  PI\/0TAL  MULTIPLIER  LEQ20570 

0  PMULT  =  -A ( K ,  I  )/ A(  I  ,  I  )  LEQ20580 

C  APPLY  PMULT  T0  ALL  C0LUMNS  0F  THE  CURRENT  A-H^ATRIX  R0W                LEQ20590 

00  11  J=NN.NSIZ  LEQ20600 

Oil  A(K. J )=PMULT«A { I  , J  )*A(K. J )  LEQ20610 

C  APPLY  PMULT  T0  ALL  C0LUMNS  0F  MATRIX  B                                    LEQ20620 

C0  12  L=1.NBSIZ  LEQ20630 

012  B(K,L )=PMULT»B ( I .L  )  +  B( K.L  )  LEQ206AO 

13  C0NTINUE  LEa20650 

14  C0NTINue  LEQ20660 
C  C0  BACK  SLeSTITUTI0N  LEQ20670 
C  WITI-  B-MATRIX  C0LUMN  =  NCBLB  LEQ20680 

00  15  NC0Le=l .NBSIZ  ^  LEQ20690 

C       00  F0R  R0»  =  NR0»  LEQ20700 

00  19  I=1.NSIZ  LEQ20710 

NR0l»  =  NSIZ+ l-I  LEQ20720 

0       TEMP=0.0  LEQ20730 

C  NUMBER     0F     PREVI0USLY     CeMPLTEO     LNKNenNS    =     NXS  LEQ2074C 

NXS=NSIZ-NR0»  LEQ20750 

C       ARE  WE  O0ING  THE  B0TT0M  Rek  LeQ20760 

IFINXS)   ie.17.16  LEQ20770 

C       N0  LEQ207eO 

16     00  18  K=I.NXS  LEQ20790 

KK=NSIZ+1-K  LEQ20aOO 

018     TEMP  =  TEMP  +  B(KK  ,NC0LB )»A(NHew,KK)  LEQ20810 

017     B(  NR0W.NC0LB  )  =  (B(NR0l».NC0LB)    -TEMP  )  /  A  (  NR0V>  ,  NR0W  )  LEQ20a20 

C       HAVE  WE  FINISHED  ALL  R0WS  F0R  B-MATRIX  C0LUMN  =  NC0LB  LEQ20830 

19     C0NTINI,E  LEQ20e4C 

C       YES  LEQ20850 

FH  B-MATHIX  C0LUMK  NCBLB=NSIZ  LEQ20860 

LEQ20e70 

LE0208eO 

DETERMINANT  LEQ20890 

LEQ20900 
LEQ20910 
LE020920 
LEQ20930 
LE02094C 
LEQ20950 
LE020960 


c 

HAVE  WE  JLST  FINISHED  WI 

15 

C0NTINUE 

c 

YES 

c 

N0W  FINISH  CeMPUTING  THE 

00  20  I=1,NSIZ 

020 

OET=DET»A{ 1,1) 

0 

ADET  =  OET 

c 

WE  ARE  ALL  O0NE  N0W 

c 

WHEW... 

RETURN 
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Solution  of  Special  Systems  of  Linear  Equations 

1.  HLU    Block  Trldlagonal  Matrix  .Routine  , 

-  FORTOAN  Coded 

2.  HLUM   Block  Trldlagonal  Matrix  Routine   .   ■;;■. 

for  a  Special  Case  -  FORTRAN  Coded 

3.  SQUID  Quldlagonal  Matrix  Routine  -  FORTRAN  Coded 

4.  TRIQ   Modified  Quasl-Trldlagonal  Matrix  Routine 

-  FORTRAN  Coded 

5.  BLEQ   Band  Linear  Equations  -  FORTRAN  Coded 
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Identification:      HLU  -  Block  Trldlagonal  Matrix  Routine 

709^  FORTRAN  II/FAP  Coded 
Purpose:    To  solve  the  matrix  equation 

Q  V  -  g 
where  Q  Is  a  block  trldlagonal  matrix. 
Method:    See  the  report  NYO-2542,  "Quasl-Trldlagonal 
Matrices  and  Type-Insensltlve  Difference 
Equations,"  by  Samuel  Schechter,  May  1,1959. 

A  brief  discussion  of  the  method  follows. 

The  matrix  Q  and  the  vector  g  are  assumed  to 
be  of  the  form 


0 

0 

0 

Si 

=2 

0 

• 

0 

gg 

M, 

^5 

0 
En-1 

>    g  = 

^5 

0 

^n 

\ 

Sn 

partitioning  results  In  D.,  M. ,  E.  and  g. 
having  the  same  number  of  rows  while  E._,., 
M.,  D  .  , -,   have  the  same  number  of  columns. 
The  solution  vector  v  Is  computed  as  a  block 
vector,  partitioned  Identically  to  g. 
The  basic  method  of  solution  is  a  Gauss  elimina- 
tion scheme  on  Q  where  the  matrix  entries  in  Q 
are  treated  as  if  they  were  scalars.   However, 
no  pivoting  is  performed  in  terms  of  these 
entries.   Because  Gauss  elimination  is  a  process 
of  decomposition  of  Q  into  the  product  of  lower 
and  upper  triangular  matrices  we  call  this  proces: 
an  LU-process.   This  process  requires  at  most  n 
matrix  inversions  of  matrices  whose  orders  are 
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those  of  M.  as  well  as  2n-2  matrix  multiplications , 
n-1  matrix  subtractions,  3n  vector  multiplications, 
and  2n-2  vector  subtractions.  These  estimates  are 
pessimistic  since  the  inversions  are  combined  with 
some  of  the  vector  and  matrix  multiplications  in 
practice . 

A  special  form  of  Q  often  arises  when  replacing  a 
partial  differential  equation  by  finite  difference 
equations.   In  this  form  the  D.  are  all  identity 
matrices.   For  such  a  Q  the  system  may  be  solved 
by  a  method  described  in  the  reference,  called 
the  H-process.   This  method  requires  only  1 
inversion  of  a  m.atrix  whose  order  is  that  of  M 
and  2n-2  matrix  multiplications,  n-1  matrix 
subtractions,  3n-4  vector  multiplications  and 
3n-4  vector  subtractions. 

The  most  general  case  that  may  occur  is  that  only 
some  of  the  D.  are  identity  m.atrices.   In  this 
case  we  may  combine  the  H-  and  LU-processes .   An 
example  will  demonstrate  the  method  and  explain 
the  terminology  to  be  used  when  describing  input 
to  the  program. 
Example:    Suppose  Dp,  •  -  •  I'D-.       are  identity  matrices,  D   ,  is 
not  (e.g.  it  may  be  non-square  or  have 
elements  off  the  main  diagonal),  D,  ,2'°''''^k     ^""^^ 


identity  matrices,  D^^  _^-^  is  not  an  identity. 


ko+1 

.  D  are  ide 

n 

the  form 


,   , o  • o .  D  are  identity  matrices.   Then  Q  has 
Ko+^      n 
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M,   E,   0 
I      Mg   E^ 

0     .      . 

I 

\ 

\ 

°l  °  ' 

O 

\.l 

0                   ' 

\2                                        O 

^2    1     ^2 

o 

o 

1^           \+2\+2 
10           .            .            . 

Q  may  then  be  considered  In  the  form 


M- 


D^  M, 


where 


M^  E^  0 


0       . 

.       0 

0      0 

.      0 

•  I-r 

\o 

.      0 

0   D, 


¥ 


0   0 


0      I   M^ 

etc.,  and  g  and  v  should  then  be  considered  as 
partitioned  In  the  following  way: 
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where 


.  I 


The  entire  system  is  thus  written  as 

q'  v'  =      g'  (1) 

The  HLU  method  now  consists  In  solving  (1)  by 
an  LU-process.  This  will  require  the  solving 
of  subsystems  of  matrices  (I.e.  Inverting  of 


matrices)  of  the  order  of  M, 


Now  the  LU-process 


will  not  destroy  the  Important  property  that  the 
m'.  possess,  viz.,  the  occurrence  of  Identity  blocks 
below  the  diagonal  of  m'   thus  an  H-process  may  be 
used  to  (essentially)  Invert  these  M^.  (suitably 
modified  by  the  LU-process).   So,  the  Inversion 
of  a  matrix  of  the  order  o: 
Inversion  of  a  matrix  of  the  order  M^ 


of  a  matrix  of  the  order  of  M .  is  replaced  by  the 

.nd  some 

number  of  matrix  multiplications. 

For  further  reference,  call  the  number  of  Mj ' s  in 
q',  the  number  of  grand  partitions;  call  the  D^^_^-^ 
linking  D.   Note  that    "^ 
m  each  grand  partition  are  square  and  of 


which  appears  In  D.  a 


the  Mj_ 

the  same  order.   We  thus  have  a  complete  descrip- 
tion of  Q'  (or  Q)  If  we  have: 


The  M-ma  trices,  M-j^ , 


M 


The  E-ma trices, 


The  linking  D-matrlce£ 
The  g-vector,  g-. 


n' 

^n-1' 
D.,, 


k-,+1 


V+1^ 


S. 


The  number  of  grand  partitions,  m+1; 
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6.  The  number  of  M.  in  each  grand  partition, 
k^  ...  n-k^; 

7.  The  order  of  the  M.  In  each  grand  partition. 

The  above  seven  sets  of  objects  constitute  the 
input  to  the  program. 
Usage:     (See  also  the  appendix  to  this  write-up.) 

This  program  has  been  constructed  as  a  subroutine, 
Its  calling  sequence  is 

CALL   HLU(N) 
Part  of  the  input  is  expected  on  tape  and  part  is 
expected  in  C0MM^N. 
1 .  Input 

A.   C^MM^N  storage  allocated  as  in  the  statement 

C0M10N     L1,L2,L3,L4,L5,l6,W^K(I) 
where 
LI    is  the  symbolic  name  of  the  tape  containing 

the  M-matrices, 
L2,L3  are  the  symbolic  names  of  two 

(necessarily  distinct)  scratch  tapes, 
L4   is  the  symbolic  name  of  the  tape 

containing  the  E-matrices, 
L5   is  the  symbolic  name  of  the  tape 

containing  the  g-vectors, 
L6    is  the  symbolic  name  of  the  tape  containing 

the  linking  D-matrices. 
Note:   In  general,  none  of  the  symbolic  tape  names 
may  be  equal  to  one  another.   (See,  also. 
Appendix. ) 
W0RK(I)  is  the  name  of  a  block  of  storage 

used  as  working  space  by  HLU. 

I  =  kj      +  7,  where  7  is  the  largest 

order  of  any  M. .   (This  routine  has 

been  compiled  with  7  =  80,  see  Program 

Construction. ) 
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B.  Tapes  are  used  to  contain  the  M-,  E-,  and 
linking  D-matrlces  and  g-vector.   Each  matrix 
should  be  written  as  a  distinct  binary  logical 
record  by  columns,  e.g.  with  the  FORTRAN  II 
statement 

WRITE  TAPE  4,((E(I,J),  1=1,?),  J=l,?) 

C.  An  array,  N(M),  must  be  transmitted  through  the 
calling  sequence.   This  array  contains  the 
information  about  the  number  of  grand  partitions, 
the  number  of  M.  in  each  grand  partition  and 
their  orders  as  follows: 

N(l)      =  number  of  grand  partitions  (say,  M) 
N(2J),     for  J  =  1,M,  =  number  of  M^  in  the  J-th 

grand  partition, 
N(2J+1),   for  J  =  1,M,  =  order  of  the  M^  in  the 

J-th  grand  partition. 
Thus,  for  the  example  above, 

N(l)  =  3,   N(2)  =  k^,   N(5)  =  order  of  (say)  M^  , 
N(4)  =  '^2~\'      ^^5)  =  order  of  (say)  M^  ,      ■•■ 
N(6)  =  n-kg,    N(7)  =  order  of  (say)  M^^. 

2.  Output: 

At  the  end  of  the  computation,  the  solution 
vector  V  will  be  written  over  the  g-vector  on 
tape  L5  in  binary  and  in  the  same  format  as 
the  g-vector,  i.e.,  if  the  g-vector  appeared 
as  n  records  g^  ...  g   then  the  v-vector  will 
appear  as  n  records  v-,  ...  v  .   All  tapes  used 
are  rewound  upon  exit  from  HLU  and  the  matrices 
on  tapes  LI,  l4  and  l6  are  not  destroyed. 
(See,  also.  Appendix.) 

Further  Remarks : 

There  exist  certain  restrictions  on  the  use 
of  this  code.   The  first  restriction  is  on  the 
t3rpe  of  problem,  that  may  be  solved.   Since  this 
code  is  an  extended  form  of  elimination 


12^ 


without  pivoting  on  the  blocks  a  matrix  of 

IT)    w^ 
p.  ^  may  not  be  solved  even  If 

E  and  D  are  non-singular  without  further 
restructuring.   The  second  restriction  Is  on 
the  minimum  number  of  Inversions  which  apparently 
must  be  performed.   If  n  Is  the  number  of  M. 's  In 
Q  then  In  repartltlonlng  Q  to  arrive  at  Q'  It  has 
been  our  experience  that  to  retain  5  significant 
figures  no  M.  should  contain  more  than  5  M. 's 
and  hence  the  number  of  Inversions  must  be 
at  least  n/5. 
Program  Construction  and  Space  Requirements: 

The  program  consists  of  five  subroutines: 
HLU,  HLU2,  HLU3,  HLU4  and  HLU5.   The  first  four 
routines  are  FORTRAN  Il-coded  while  HLU5  Is  a 
FAP-coded  matrix  multiplication  program  employ- 
ing inner  product  accumulation  by  sign  in 
machine  double  precision.   HLU5  may  be  replaced 
by  any  matrix  multiplication  routine  having  the 
calling  sequence 

CALL   HLU5(L,A,M,B,N,C) 
'   where  the  matrix  A  is  to  multiply  the  matrix 
(vector)  B  and  store  the  result  in  C,  and  A 
Is  of  order  L  by  M,  B  is  of  order  M  by  N  and 
C  will  be  of  order  L  by  N. 

HLU,  HLU2,  HLU5  and  mJJh   contain  the  statements 
C0MM0N  L1,L2,L5,L4,L5,L6,Q,E,H2,H1 
DIMENSION  Q(80,80),E(80,80),H2(80,80),Hl(80,8l) 
where  L1,...,l6  are  symbolic  tape  names  and  the 
arrays  Q,E,H2,H1  occupy  the  area  named  W0RK 
which  was  mentioned  in  the  Input  description 
(see  Input,  A) .   The  arrays  Q,E,  and  H2  should 
be  square  and  of  dimension  7x7.   The  array 
Hi  should  be  of  dimension  7  x  (7+I).  ^■<*^u.: 
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HLU5  contains  a  constant 

II  SYN   80 
used  for  Indexing  in  the  process  of  matrix 
multiplication  and  so  must  be  the  same  as  the 
row  dimension,  y,    of  the  arrays  written  above. 
If  the  subroutine  HLU  is  to  be  recompiled  for 
a  different  amount  of  working  space  then  the 
DIMENSION  statements  and  the  SYN  value 
should  be  changed  to  the  appropriate  value. 

The  program  was  compiled  with  rounding  and 
without  the  standard  error  feature  and  occupies 
2032)0  locations.   Utility  routines  are  required 
to  service  the  FORTRAN  II  statements  READ  TAPE, 
WRITE  TAPE,  REWIND  and  BACKSPACE.   A  routine 
to  solve  linear  systems  is  required  in  HLU3 
and  HLU4 .   The  routine  used  is  LEQ  which  has 
the  calling  sequence 

CALL  LEQ(A,B,M,N,LA,LB,D) 
where 
B    is  a  matrix  of  N  column  vectors 

(M- components) 
A    is  a  matrix  of  order  M  to  be  inverted 

and  applied  to  the  vectors  of  B. 
LA    is  the  value  of  the  row  dimension  of  the 

array  A 
LB    is  the  value  of  the  row  dimension  of  the 

array  B 
D    will  contain  the  value  of  the  determinant 

of  A.  This  value  is  not  used  by  HLU. 
XL0CF  is  used  to  compute  LA  and  LB  in  HLU. 
LEQ  is  a  Gauss  elimination  process  with  row 
equilibration  and  column  pivoting.   Either 
single  precision  version  of  LEQ  listed  in 
this  report  satisfies  the  requirements  for 
this  routine.   The  routine  uses  the  built-in 
library  function  XABS . 
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Author:    J.  Richard  Swenson 
Date:      February  I965 

Appendix: 

1.  In  the  general  use  of  HLU  It  Is  possible  to 
combine  tapes  LI  and  L5  (M-matrlces  and  g-vectors) 
provided: 

a.  the  information  written  on  the  combined  tape 
appears  in  the  proper  order, 

b.  it  is  not  necessary  to  preserve  the  M-matrlces 
after  HLU. 

(a)  will  be  satisfied  so  long  as  the  information 
written  on  the  combined  tape  appears  in  the  order 
g^M^ggMg  . . .  g .M.  . . .  g^M^  . 

2.  If  HLU  is  to  be  used  strictly  as  an  LU  process, 
viz.,  as  a  block  Gauss  elimination  procedure, 
then  it  is  possible  to  lessen  storage  and  tape 
requirements  considerably.   HLU  is  used  strictly 
as  an  LU  process  when: 

N(2I)  =  1  for  1=2  through  2*N(1)  at  steps  of  2, 
(See  Input,  C.)   To  lessen  the  program  storage, 
remove  cards: 

HLUOO3OO , 00410 , 00420 , 00650-00990 , 01190 , 
01265,01410,01420,01620,01690-01920, 
01970,02004,02005,02006,02050,02070 
and  replace  card  HLUO2090  by 

G0  T0  4  HLUO209O 

The  resulting  deck  will  then  be  approximately 
1250)0  locations  long. 

To  lessen  the  tape  requirements  it  is  possible 
to  combine  tapes  l4  and  l6  (only  in  this  case), 
provided  that  the  information  written  on  the 
combined  tape  appears  In  the  following  order: 
E^DgE^D^  . . .  E.D^^^  . . .  E^_^D^  . 
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*        R0UNO 

CHLU     NYU  MATH  UT I L/HLU/QUA S I - TR I O I  AG 0N AL  MATRIX  RauTINE     PART  1   0F  5  HLUOOOIO 
C       NYU  MATH  UTIL  /  HLU  /  2-10-65      J  R  SweNS0N  HLU00020 

C       ••••♦•THIS  DECK  IS  SERIALIzeO  FR0M  HLUOOOIO  T0  HLU03050 ••••••• ••••HLUOOO 30 

C       .THIS  SUBR0UTINE  IS  SERIALIZED  FR0M  HLUOOOIO  T0  HLU00620 HLU00040 

SUBR0UTINE  HLU  (NN)  HLU00050 

C       THCSE  DIMeNSI0NS  SH0ULD  BE  THE  SAME  AS  THBSE  IN  THE  MAIN  PR0GRAM   HLU00060 

DIMENSION  Q( 80.80) .E(30. 80) .H2(80. 60) .HI (80.81 )  HLU00070 

C       THESE  DIMENSI0NS  NEED  N0T  BE  ^'0OIFIED  HLUOOOSO 

DIMENSiaN  IMN(I)  HLU00090 

C0MM0N  Ll.L2.L3,L4,L5.L6.  HLUOOIOO 

Q,E.H2,H1  HLUOOllO 

C  LI  =  TAPE  C0NTAINING  M-MATRICES.  HLU00120 

C  L2.  L3  =  INTERMEDIATE  SCRATCH  TAPES.  HLU00130 

C  LA  =  TAPE  C0NTAINING  E-MATRICES.  HLU00140 

C  L5  =  TAPE  C0NTAINING  G-VECT0RS.  HLU00150 

C  L6  =  TAPE  C0NTAINING  D-MATRICES.   ( 0NLV  LINKING  O'S).       HLU00160 

C...  THIS  PR0GRAM  REQUIRES  A  MATRIX  INVERSI0N  R0UTINE.  IT  IS  CALLED  IN  HLU00170 

C...  HLU3  AND  HLU4  AS  LEQ.  HLU5  IS  JUST  A  MATRIX  MULTIPLY  H0UTINE.       HLU00180 

C»«^»  IF  NN(K)  =  1  F0R  K  =  2.2»NN(1),2  THEN  REM0VE  CARDS  HLU00190 

C30 C. 4 10, 420, 630-990. 1 190. 12 65. 1410. 1420. 1620. 1690-1920. 1970.2004.2005.  HLU00200 

C20C6  AMD  REPLACE  CARD  2090  BY  G0  T0  4  HLU00210 

C       THIS  WILL  SAVE  APPR0X I  MA  TEL Y  340  L0CATI0NS.  HLU00220 

REWIND  LI  HLU00230 

HLU00240 

HLU00250 

HLU00260 

HLU00270 

HLU00280 

HLU00290 

HLU00300 

HLU003 10 

INITIALIZE  HI  AND  H2  F 0R  HLU2  0R  HLU4 .       HLU00320 

,1  =  I.N3)  HLU00330 

I.      I     =     l.N3).J     =     l.N3>  HLU00340 

HLU00350 
HLU00360 
HLU00370 
HLU00380 
HLU00390 
HLU00400 
HLU00410 
HLU00420 
HLU00430 
HLU00440 
HLU00450 
WRITE     ANSWERS     0N    TAPE     L5    FR0M     TAPE    L3.  HLU00460 

HLU00470 
HLU00480 
HLU00490 
HLU0  0  500 
HLU00510 
HLU00520 
,N     =     I  ,f)  HLU00530 

HLU00540 


REWIND  L2 

REWIND  L3 

REWIND  L4 

REWIND  L5 

REWIND  L6 

K  =  2  *  NN 

(  1  ) 

N2  =  NN( 2) 

-  I 

N3  =  NN(3) 

READ  TAPE  L5. 

(Hl(  I  .  I) 

READ  TAPE  LI  , 

( (H2(I .J 

D0  5  I  =  l,N3 

D0  4  J  =  I,N3 

HI t  I  .J  +  1  ) 

=  0. 

C0NTINUE 

Hl(  I  ,  I  +  l  ) 

=  1. 

C0NT INUE 

IF  (N2)  6.7. 

6 

CALL  HLU2  (N2. 

N3) 

IF  (K  -  2)   1 

.2.1 

CALL  HLU3  (NN) 

CALL  HLU4   (NN) 

REWIND  L5 

00  3  I  =2.K.2 

L  =  NN( I ) 

M  =  NN( I+l 

) 

D0  3  J  =  l.L 

BACKSPACE  L3 

READ  TAPE  L3, 

(HKN.l) 

BACKSPACE  L3 
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3  WHITE  TAPE  LSt   (Hl(N,l),N  =  l,M)  HLUOOSSO 

Rt*IND  L 1  HUU00S60 

REWIND  L2  H(.U00970 

RhWiNO  L4  HLUOOSaO 

REWIND  L5  HLU00S90 

REWIND  L6  HLUOOeOO 

RETURN  HLU00610 

END  HLU00620 

•        R0UND 

CHLL2       H  PR0CESS  0N  SU8-P AR T I T I 0N S  PART  2  0F  5  HLU00e30 

C       .THIS  SUBR0UTINe  IS  SERIALIZED  FRe»'  HLU00630  TB  HLU00990 1-H.U0064C 

SUBR0UTINE  HHJ2  (MMl.yM2)  HLU00650 

C       THESE  DIMENSI0N5  SH0LILO  BE  THE  SAKE  AS  TneSE  IN  THE  MAIN  FR0GRAM   HLU00660 

DIMENSI0N  0( 80.80)  .E(80. 30 )  .H2  (60. aO)  .HI  (60.61  )  HLU00670 

C0^'M0N  L  1  .L2.L3.L4  .LS.L6.  HLUOOfiaO 

Q.E,H2.HI  HLU00690 

C  LI  =  TAPE  C0NTAIMNG  M-MATRICES.  HLU00700 

C  L2.  L3  =  INTERMEDIATE  SCRATCH  TAPES.  HLU00710 

C  LA  =  TAPE  C0NTAIMNG  E-MATRICES.  HLU00720 

C  L5  =  TAPE  C0NTAIMNG  G-VECT0RS.  HLU00730 

C  L6  =  TAPE  C0NTAIMNG  D-MATRICES.   (  BNLY  LINKING  O'S).       HLU00740 

C  F0RWARO  RECURSI0K  IN  A  SljE-P  Afi  T I  T  I  0N  IS  DEFINED  BY  HLU00750 

C  UM*  =  GM',  H'O'  =  I.  HM'  =  MM*  HLU00760 

C  H'N>   =  H'N-1«»   M«N'  -  H'N-2««  E'N-J«  HLU00770 

C  U*N»  =  H'N-1«»  G'N*  -  L'N-l"  HLU0C7e0 

C       H2  AND  HI  ARE  FILLED  FR0M  HLU  0R  HLU3.  MM!  =  NUMBER  flF  M'S  IN       HLU00790 

C       A  SUBPARTI TI0N.  MM2  =  THEIR  0RDER.  HLU00800 

M2  =  MM2  HLUOOeiC 

00  3  M  =  l.MMI  HLU00820 

READ  TAPE  L5.   (E(I,1).I  =  I.M2)  MLUOOSSO 

CALL  HLU5  ( M2 , H2 , M2 . E . 1 ,E ( 1 . 2 ) )  HLUOOSAC 

D0  1  I  =  I.M2  HLUOOeSO 

Hl(I.l)  =  E(I,2)  -  Hl(I.l)  HLUOOeeO 

1  C0NTINUE  HLU0Oe70 

READ  TAPE  LA,   (<Q(I.J).I   =  l.K2).J  =  1  .M2 )  HLUOOeeC 

CALL  HLU5  (M2.H1 (  1  ,2)  .M2.C.M2  .E)  HLU00e9C 

READ  TAPE  LI.    (  (HI  (  I , J+1  )  ,1   =  I  . M2 )  , J  =  1,M2)  HLU00900 

CALL  HLU5  (M2,H2,M2.H1 ( 1 .2) .M2,C)  HLU00910 

HLU00920 
HLU0093C 
HLU00940 
HLU00950 
HLU00960 
HLU0097C 
HLU0C9e0 
HLU00990 

)S  PART  3  0F  5  HLUOICOO 

JBM  HLUOJOOO  T0  HLU01450 HLUOIOIO 

SUBR0UTINE  FLU3  ( NN  )  HLUOI020 

THESE  CIMENSI0NS  SH0ULD  BE  THE  SAVE  AS  THBSE  IN  THE  MAIN  FR0GRAM   HLU01030 

DIMENSI0N  G( eC.BO)  .E (aO.eC )  .H2  (60.80)  .HI  (80.8  1  )  HLUOI04C 

THESE  OIMeNSI0NS  NEED  NBT  BE  M0CIFIED  HLU01050 

DIMENSI0N  NN(n  HLU01060 

C0VM0N  L 1 .L2.L3.L4,L5,L6.  HLU01070 


00  2  I  =  1.M2 

00  2  J  =  1.M2 

HI  (  I  . J+  1  ) 

=  H2 (  I  .  J  ) 

H2 (  I  . J  )  = 

0(1. J)  -  E(I.J) 

2 

C0NTINUE 

3 

C0NT INUt 
END 

RETURI 

• 

R0UNO 

CHLU3 

F0RWARO  LI 

INK  T0  NEXT  H-PR 

C 

•THIS  bUBR0UTI 

[NE  IS  SeRIALlZEl 
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Q.E.H2.H1  HLUOlOaO 

LI  =  TAPE  CBNTAINING  M-fAT«ICES.  HLU01090 

L2.  L3  =  INTERMEDIATE  SCRATCH  TAPES.  HLUOllOO 

L4  =  TAPE  CBNTAIMNG  E-KATRICES.  HLUOlllO 

L5  =  TAPE  C0NTAIMNG  G-VECTflfiS.  HLU01120 

L6  =  TAPE  CBNTAINING  0-MATRlCES.   < BKLV  LINKING  O'S).       HLU01130 

K  =  2  •  NN( 1 )  HLU01I4C 

DETERMINE  THE  NUMBER  0F  RBhS  IN  Jt'E.    HI  MATRIX.  HLUOllSO 

LA  =  XABSF(XL0CF(H1( 1  ,1)  )  -  XLBCF (H 1 ( I ,2 ) ) )  HLU01160 

D0  4  I  1  =  3,K,2  HLU01170 

MM2  =  NN(Il)  HLUOlieO 

MM4  =  NN(I1  ♦  1)  -  I  HLU0tl90 

MM3  =  NN(I1>2)  HLU0t200 

MM21  =  MM2  ♦  J  HLU01210 

CALL  LEO  (H2.HI ,MM2.MM2l .LA.LA.O)  HLU01220 

FETCH  AN  E  MATRIX  HLU01230 

READ  TAPE  L4.   ((0(1. J), I  =  l.»'M2).J  =  J,KM3)  HLU01240 

CALL  HLU5  (  MM2  .  H  1(  1  ,  2  )  ,MM2  ,  Q  .  f»M3  .H2  )  HLU012S0 

WRITE  TAPE  L2.   (  H  t  (  I  .  I  )  .  (  H2  (  I  .  J  )  .  J  =  l.MM3).I  =  l.l'M2)                HLU01260 

.  ((0(1. J). I  =  l.KM2).J  =  l.»'M3)  HLU01265 

FETCH     A     D-MATRIX  HLU01270 

READ     TAPE     L6.     ((0(1. J). I     =     l.fM3).J     =     1.MM2)  HLU0I280 

.MM3.H1(1 .2) )  HLU01290 

,1 ,E)  HLU01300 

[     =     LVMS)  HLU01310 

I     =     I.KM3).J     =     1.MM3)  HLU01320 

HLU01330 

HLU0I340 

-11(1, J+1)  MLU0I350 

HLU01360 

t     C0NT1NUE  HLU01370 

Hid.  I)     =     HKI.n     -    E(I.I>  HLU01380 

HUI.I-H)     =     1.  HLU01390 

2  C0NTINUE  HLU01400 

IF  (MM4)  3.4.3  HLUOI4I0 

3  CALL  HLU2  (MM4,MM3)  HLU01420 

4  C0NTINUE  HLU01430 

•                  RETLRN  HLU0144C 

END  HLU014S0 
•         H0UNO 

CHHJ4       BACKWARDS  SUBSTITUTION  PART  4  BF  5  HLU01460 

C       .THIS  SUBR0UTINE  IS  SERIALIZED  FRBM  HLU01460  TB  HLU02110. HLU01470 

SUBRBUTINE  HLU4  ( NN )  HLU01480 

C       THESE  DIMENSIONS  SH0tLD  BE  THE  SAME  AS  THBSE  IN  THE  MAIN  PR0GRAM   HLU01490 

DIMENSION  0(80.80) .E(80. 80) .H2(80.80)  .HI  (80.81 )  HLUOISOO 

C       THESE  DIMENSIONS  NEED  NOT  BE  MBDIFIEO  HLU015I0 

DIMENSION  NN(1)  HLU01520 

COMMON  L 1 .L2.L3.L4.L5.L6.  HLU01S30 

Q.E.H2,HI  HLU0154C 

C                                              LI     =     TAPE     CBNTAINING     M-MATRICES.  HLU01550 

C                   L2.  L3  =  INTERMEDIATE  SCRATCH  TAPES.  HLU01S60 

C                   L4  =  TAPE  CONTAINING  E-MATRICES.  HLU01570 

C                   L5  =  TAPE  CONTAINING  G-VECTORS.  HLU01580 

C                   L6  =  TAPE  CONTAINING  D-MATRICES.   (ONLY  LINKING  D'S).       HLU01590 

C       H2  AND  Hl(«.l)  ARE  FILLED  FROX  HLL  OR  HLU2  VIA  HLU3.  HLU01600 


CALL 

HLU5 

(MM3 

.0.MM2 

.H2 

CALL 

HLU5 

(MM3 

.Q.MM2 

.HI 

READ 

TAPE 

L5, 

(Hl( I, 

1  )  . 

READ 

TAPE 

LI  . 

((0(1. 

J)   . 

DO  2 

I  = 

1.MM3 

D0  1 

J  = 

1  .MM3 

H2(  I. 

J  )  = 

0(1. J) 

-  1 

Hl(  I  . 

J+1  ) 

=  0. 
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\H     "     ■/     "NNC  I  ) 
Nl     '     NN(K )  I 

N  1     '     NN(K •  I  ) 

C  t>*)t  vh    f-viu    n^^     wi  My    lA'.r    f  nMcust  m    m     m 

LA     *     XAH*>f   (  XI  HCf  (Ml  (  1  .  1  )  )  Ml  KC  F   ( >U  (  I  .  ;<  )  )  ) 

C  USiL     NYU    LKO     l«    CDMPUIf      TM(-     MUllJlltth     DF     li;- • )(  -  H  1  (  •  .  I  )  . 

rAI  I      IPO     (H?.HI  .N  1  .  I  .LA.I.A  .1)  ) 
Wl(  I  Tl       I  Al>l      II.      (II  I  (  I  .  I  )  .  I      -      I  .m  ) 


I  .   ) 


11.(1,.')      -     o . 
MAfK'jI'ACf     LI 
MACK-jI'ACh     L*l 
MtAD     I  Al»l-     LI.      (Mill 

Ct I  AM  M  MA lUI « 
lit  An  r  Al'h  II.  (  (I  (  I 
CALL     lillj'i     (M  I.I    .N  1.1 


'       I   .S    1)   .  J      ^       I  .N  I) 
I  I  (  I   .    !  I  ) 
1(1        Vt       I   I   f    I      l<«NO     S  I  DE 


nA(  KM-AI   1       1     1 

IIA<  KM'Al  I       1    H 

IIAIKSPACI      LS 

Nl      -     Nl     -      1 

If       (Ml)      '»0.'».'>0 

(.1     1      All     1       M/V  III  1  X 

Id    All      1  Al'l       11.       (   (1    (    1   .  J  ! 

1  .1 

IIALK'jI'ALL      LA 

CALL     HLUti     (N  ).L  .N  1  .III  1 

1  1  ..* 

bU     rM     2 

K     «    K-y 

IK     (K)     ?S.  7,t) 

M     ClfMPONLI 


n;;   '   N3 

Nl     ■■     NN(K  )     -     I 
NJ     "    NN(K«l > 
HACKSI'Afl      L? 
Ill   AH     I  AIM      I   :•.      (tl.'(  I  .  I  ) 

.      (  ( I    (  I  .   I  )  .  I  I  .N  I  )  , 

II       (  N  I    )      I'. 'J.  II 
(All       |i|    U>>      I  N  I  ,r  .N4'  .11  I  .   I   .11.' (   I   .  .'  )  ) 
(Alt       HI   U^      (N.1.III  (   1  ..'  )  .N.-.lll   .  I    .M. 
IH1     f.      I         »l.N3 

hi  (  I  .  1  )      •     MiM  I  .  I  I      -      M.'(  I  .1  ) 
win  II-       1A(H       LI.       (HI   (   I  .  I    >  .  I       -      I   .N  ' 
(lACKSPACK     LI 
IIAtKSI'Aff     L? 
IIACKSI'ACf     L* 
HACK'il'ACt     L9 

\f      (Nl >     2. A.? 

HE lUHN 
fNIl 
maiNAMV     MAIHIX     MIIL  1  I  I'L  I  <- A  I  I  If  N 


IM  I   .  JU  )  .J     •      I.S?)  . 
I  .  N  I  )  .  J      '       I   .  N  .>  I 


MLU0  16  10 
ML UO 1620 
HLUO  f  63C 
MLU016AO 
HLUO 1650 
HLUO  1660 
HLU01670 
MLUOl6e0 
HL  UO 1 690 
HL 00 1 7  00 
HLUO 17  10 
HLUO  1  7  20 
HLUO  I  7  JO 
HLUO  1  7«C 
HLUO  I  750 
HLUOl 7  60 
HLUO  I  7  70 
HLUOl  780 
HLUOl 790 
HLUO 1800 
HLUO  I  8  1  0 
HLUO  182  0 
HLUO I H30 
HLUO  I  HA C 
HLUO IBbO 
HLUO  I860 
HLUO 1870 
HLUO  I  880 
HLUO  I  890 
HLUO I  900 
HLUO  I  9  10 
HLUO 1920 
HLUO 1930 
HLUO  ICAC 
HLUO  I  950 
HLUO I960 
HLUO 1970 
HLUO  1  980 
HLUO  l<;90 
HLU02000 
HLU0200A 
HLU0  2C0  5 
HLU02006 
HLUO 20 10 
HLU02020 
HLU02030 
HLU020AC 
HLU02050 
HLU02060 
HLU02070 
HLU020aO 
HLU02090 
HLU02 100 
HLUO  2  1  10 
HLU02120 
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•        N0  STANDARD  ERRBR  HLU02130 

«        FAP  HLU02140 

•HLU5   0ROINARY  MATRIX  MULTIPLICATION  PART  5  BF  5  HLU02130 

I       .THIS  SUBR0UTINE  IS  SERIALIZED  FHBV  HLU02I20  T0  HLU03050 HLU02160 

PCC  HLU02I70 

LDL       HLU5  HLU02iaO 

C0UNT     It  HLU02I90 

ENTRY     HLU5  HLU02200 

REM       REFERRED  T0  BY  THE  FBRTRAN  STATEt'ENT  MLU02210 

REM  CALL  HLtl7  (L.A.M.n.N.C)  HLU02220 

REM       *ITH  THE  SPECIFICATION  HLU02230 

REM  DIMENSIBN  A (  I  I  .  I  I  ) . Q (  I  I  .  I  I  )  . C I  I  I  . I  I  )  HLU022AC 

II      SYN       80  II  =  eC  HLU02230 

CP      USS       2  D0LBLE  PRECISISN  ST0RACE  HLU02260 

CM      BSS       2  OetlBLE  PRECISieN  ST0RAGE  HLU02270 

DIM     ...        II  HLU022eO 

0Nb     ...        1  HLU02290 

HLU5    SXA       EXIT-1.4         SAVE  THE  INDEX  REGISTERS  HLU02300 

bXA       EXIT-2.2  HLU02310 

SXA       EXIT-3.1  HLU02320 

REM        INITIALIZE  ADDRESSES  AND  LBBP  DECREMENTS  HLU02330 

CLA       2.4  SETUP  A  ADDRESSES  HLU0234C 

ADD       VINE  HLU023S0 

bTA       H.3  HLU02360 

CLA       4, A  SETUP  e  ADDRESSES  HLU023rO 

ADC       UNE  HLU023aO 

bTA       H.3+2  HLU02390 

STA       H.3+5  HLU02400 

CLA       6.4  SETUP  C  ADDRESSES  HLU02410 

ADC       0NE  HLU02420 

STA       H.e-3  HLU02A30 

CLA»      l.A  =L  HLU0244C 

STC       H.q  MCU02A50 

CLA*      3,4  =M  HLU02460 

STD       H.6*l  HLU02470 

XCA  HLU024eO 

MPY       DIM  M*I  HLU024QO 

XCA  HLU02300 

STD       H.6  HLU025I0 

LCQ«      5,4  =N  HLU02a20 

MPY       DIM  N«l  HLU02S30 

XCA  HLU02S4C 

STC       H.B  HLU02390 

HLU02360 
MLU02570 
MLU025eO 
HLU02590 
HLU02600 
HLU0  26  10 
HLU02620 
HLU02630 
MLU0264C 
HLU02630 
HLU02660 
HLU02670 


AXT 

1  ,  1 

C0LUMNS  0F 

A  (BY  R0*S> 

AXT 

1  ,2 

C0LUMNS  0F 

C  (OY  R0«IS) 

HEM 

QEGir 

•1     0UTER  L00P 

REM 

D«  H, 

.'i     1  =  1, L 

AXT 

I  .4 

R0MS  0F  B 

(BY  C0LUMNS) 

HEM 

DK  H. 

.n    K=l ,N 

REM 

SET 

INTERMEDIATE  STBfiACE 

T0  0. 

STZ 

CP 

bTZ 

CM 

STZ 

CP*  1 

iy> 


OLDCK  TRIOIACeNAL  CATRIX  RSLTINE  -  FflRTRAN  tl  ANO  F AP  CBCEO 


HtM  IICGIN     INNTB    PR0DLCI     CeMPLTATIBN.  HLU026eO 

CLA  •••1  A(I.J)                                                                                                                        HLU02690 

r/E  H.6-?  HLU02700 

Hll  »».t  H(J.K)                                                                                                                        MLU02710 

TKA  H.6-2  HLU02720 

XtA  HLU02730 

FMP  ••,4  n(J,K)                                                                                                                        HLU0274C 

T/C  H.fj-i?  HLU02750 

Wl  M  ACCljMULAie  INNER     PRBCLCT     BY     SIGN.                                                                               HLU02760 

TPL  »*1  HLU02770 

DFAO  CM  ACCLMLLATE     KEGATIVF     PART                                                              HLU027eO 

DST  CM  HLU02790 

rUA  •♦3  HLU02e00 

QFAD  Ct'  ACCUMULATE     POSITIVE     PART                                                              MLU02eiO 

OST  CP  HLU02e20 

TXl  •♦l.I.II  STEP     J     IN     A(I,J)                                                                                        HLU02e30 

rxl  •♦l.A.l  STEP     J     IN     eCJ.K)                                                                                        HLU02e«C 

VtK  C.J.l,"*  TEST     Fefl    LAST     C0LUKN     0F     A                                                           HLU02e50 

Kl   ^'  tNO     MF      INNER     PRBCLCT     LBBF.  HLU02e60 

HIV  ACCUMULATE  FINAL      INNER     PBeOUCT.                                                                                     HLU02e70 

TIX  ««i.«,»«  RESET     J     IN    e(J.«)                                                                                     HLU02e80 

ULC  CP  HLU02eqO 

DFAP  CM  HLU02900 

FKN  HLU02910 

bin  ««.2  STBHE     C(I.K)                                                                                                     HLU02920 

IXI  •♦l.A.Il  SET     K=KtI      IN     B(«.K)                                                                               HLU02930 

TXI  "M.S.  II  SET     K  =  K*l      IN     C(I,K)                                                                               HLU0294C 

INK  H.2,2,«»  TEST     FKR    LAST     C0LUVN     fIF     B                                                           HLU02"350 

l*t  M  (  ND     0F     C0LUMN    L00P  HLU02960 

IXI  •♦I.I.I  SET     I»I*I      IN     A(I.»)                                                                              HLU02970 

TXI  •♦1.2.1  SET     IxMl      IN     C(I.«)                                                                              HLU02980 

rXL  ♦.1,1. ••  TEST    FBR    LAST     R0W     KF     A.                                                                 HLU02990 

WLM  LND     0F     R0W  L00P                                                                                                                                       HLU03000 

AXI  ••, 1  HLU03010 

AXT  ••.2  MLU03020 

AXT  ••.«  HLU03030 

IKA  f.n  MLU030AC 

CNO  HLU03050 


-  137  - 


Identification:      HLUM  -  Block  Trldlagonal  I'fetrlx  Routine 

for  a  Special  Case 
7090  FORTRAN  Coded 
Purpose;    To  solve  the  matrix  equation 
Q  V  =  g 
for  the  special  form  of  Q  shovm  belov/  v/here  M 
is  a  square  matrix  and  I  is  the  identity  matrix. 
This  special  case  makes  it  unnecessary  to  use 
the  tapes  required  by  the  more  general  code  HLU 


M  I   . 
I  M  I 

o  ■ 


O 


.   I 

I   M 


r—            -n 

»—       — 1 

^1 

gl 

^2 

= 

g2 

_^n_ 

_^n. 

Method: 


Usa; 


The  procedure  used  by  HLU  has  been  applied  to 
this  special  case.   For  a  detailed  description 
see  the  v;rite-up  for  HLU  and  IJYO  Report  2^42, 
"Quasi-Tridiagonal  Matrices  and  Type-Insensitive 
Difference  Equations,"  by  Samu.el  Schechter. 
The  routine  is  entered  by  the  statement 

CALL  HLUM 
The  information  concerning  the  system  to  be 
solved  is  transmitted  through  C/^W^]   storage. 
The  subroutine  uses  the  following  C0im.0ll   and 
DIMENS I0N  s ta t  ement  s : 

C0im0lJ     N,F,F0RT,TRY0i:/Hl,H2,QTI/!,G,V^IJK,LMN 
DIMENSI01I  N(Z)  ,P(Y,Y)  ,F0RT(Y/f )  ,TRY0N(Y,Y)  , 

H1(Y//),H2(Y,Y),QTI/[(Y,Y),G(Y,1),W(Y,1) 
v/here 
Z    is  equal  to  2-!:?  +  1  vjhere  NP  is  the 

number  of  M  matrices 
Y    is  the  order  of  the  M  matrix 
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F0RT  is  the  M  matrix 

TRY0N  contains  the  vector  g  as  its  columns, 

i.e.  g^  =  TRY$^N(I,1),  gg  =  TRY0N(I,2),  etc. 
P    will  contain  the  solution  vector  v  stored 

as  its  columns  in  the  same  fashion  in  which 

the  g's  are  stored. 
The  program  is  compiled  with  X  =  101  and  Y  =  50 . 
The  routine  uses  logical  tape  2  (B2)  for 
intermediate  storage. 
Requirements: 

a)  Non-System  Subroutines 
LEQ 

This  is  a  subroutine  which  solves  a  system  of 
simultaneous  linear  equations.   Either  single 
precision  version  of  LEQ  listed  in  this  report 
satisfies  the  requirements  for  the  routine. 

b)  System  Library  Functions  (closed  subroutines) 
XL^C 

The  routine  also  uses  the  subroutines  necessary 
to  read  and  write  a  binary  tape  and  to  rewind 
and  to  backspace  a  tape.   These  routines  are 
discussed  more  fully  in  the  last  section  of 
this  report. 

c)  Storage 

1228^^^  =  ^^•'-^R  locations  plus  the  required 
subroutines  listed  in  a)  and  b). 
Author:    Eva  V.  Swenson 
Date:      April  I962 
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N3  = 

NN(  I) 

Nl  = 

NN(2) 

N2  = 

NN(  3) 

UK 

=  1 

DU 

fl      1  =  1 

.  r.  2 

G(  I 

.  1  )  =TI 

^Yei, 

K  I  . 

CO 

«     J  =  l 

.N2 

CTI' 

(I.J) 

=F0RT( I 

HLOM  -  R0UTINg  HLU  F0B  A  SPECIAL  CASE  -  F0RTRAN  tl  CBOEC 

LISTS  HLUMOOIO 

LABEL  HLUM0020 

S0LVES  ELLIPTIC  EOOAIIZr.  MLUM0030 

SUER0UTINE  HLLM  HLUM004C 

C0l'M0N  NN,P,F0C»T.  TnY0U,Hl  ,H2  ,CTH  ,G  .»,  I  JK.LMK  HLUM0050 

DIMENSI0N  NN(lOl),P(5O,5O),F0(!T(5O.5O),TRYeK(5O.5O).Ml(5O.5O)  HLUM0060 

OIMENSI0N  H2(50t50  )  .QT»'(S0.50)  .G(50.  1  )  .»<50,  1  )  HLUM0070 

REWIND  2  HLUM0080 

HLUMC090 
HLUMOIOO 
HLUMOI 10 
HLUM0I20 
HLUM0130 
HLUMOI 40 
HLUMO I  50 
HLUM0160 

IJK=IJK+1  MLIJM0170 

CALL  e-lP  (^2,t^l)  HLUMOieO 

IF(SN-  1)1,2.1  HLUM0190 

N4=NN(4)  ML1JH0200 

Nb=NN(5)  HLUM02I0 

CALL  t-LINK(N2.N5,N4,N31  HLUM0220 

CALL  SULN  HLUM0230 

RETURN  MLUM024C 

ENC  HLUMC250 

LISTS  HLUH0260 

LABEL  HLUM0270 

I — PR0CESS  eN  SUBPAHT1TI0NS  HLUM0280 

SueR0UTINE  hlP<Ll.L2)  MLUM0290 

C0KM0N  NN,P,F0RT,TRy0N,Hl  ,H2,CTM,C,li.  IJK.LMK  HLUM0300 

OIMENSI0N  NN(lOl)tP(5O,5O).F0RT(5C.5O).TRYeK(&O.5O).Hl(SO.5O)  HLUM03I0 

CIMENS10N  l-2(50.50)tOTM(50.50)  .GISO.l  )  .«(50.  I  )  HLUM0320 

L3=C  MLUM0330 

00  4  1=1, LI  MLUM034C 

»{I.n=0.0  MLUM0350 

00  4  J=I . I  HLUM0360 

IF  (I-J)  3,2.3  HLUM0370 

1-2(1. J)=1.0  HLUWOSeO 

O0T04  HLUM0390 

H2(I,J)=0.0  HLUM0400 

»-2(J.I)=0.C  MLUM0410 

C0NTIHue  HLUM0420 

G0  T0  7  HLUM0430 

C0  18  1=1. LI  HLUM044C 

G(  I  .  l)=TRY0N(  I  .1  J»C)  MLUM0450 

IJK=IJK4-I  HLUM0460 

CALL  MTMPVl  (f-2  .G.2  .L  1  .  I  )  HLUM0470 

00   e    1=1. LI  HLUM04eo 

■  {  1.  l)=G(I.l  )-.(I.l)  HLUM0490 

IF(L3)      112.14.112  MLUMO«00 

00     19     1=1. LI  HLUMOOIO 

00     19     J=1.L1  HLUM0520 

ClTH(  I,J)=F0RT(  I.  J)  HLUMC530 

CALL     MTMPY  1(1-2  .0TM,2,L1  ,L1  )  HUUM0?40 

00     13     1=1. LI  HLUM0550 
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HLUM  -  HHUTINE  HLU  F BR  A  SPECIAL  CASE  -  F0RTRAN  II  C0OED 

D0  13  J=1.L1  HLUM0560 

13  CTM( I, J)=OTM( 1 .J)-H1 ( I .J)  HLUM0S70 

14  00  15  1=1. H  HLUMOSaO 
00  15  J=1.L1  HLUM0590 
HI (  I, J  )  =  H2 (  I  , J )  HLUM0600 

15  H2(  I , J  )=GTM(  I  , J)  HLUM0610 
IF  (L2-1)   16.17,16  HLUM0620 

lb     L2=L2-1  HLUM0630 

L3=L3+1  HLUM064C 

G0  T0  52  HLUM0650 

17     RETURN  HLUM0660 

END  HLUM0670 

•  LISTS  HLUM0680 

•  LABEL  HLUM0690 
CHLINK  LINK  T0  NEXT  H-PR0CESS  HLUM0700 
C  T0  ENTER  VnE  NEED  H1.H2.«  FILLED  FB0M  HIP  HLUM0710 
C  LI  =  0HDER  0F  MATRICES  IN  PREVI0US  HIP  HLUM0720 
C  L2  =  0RDER  0F  MATRICES  IN  F0LL0WING  HIP  HLUM0730 
C  L3  =  NUMBER  0F  MATRICES  IN  FeLL0liING  HIP  HLUM074C 
C             L^  =  NUMBER  0F  TIMES  T0  RE-ENTER  HIP  HLUM0750 

SU6R0UTINE  HL INK(L 1 .L2.L3.L4)  HLUM0760 

C0NM0N  NN.P.F0RT,TRY0N,H1  ,H2.CTM.G,I«I,  IJK.LMN  HLUM0770 

DIMeNSI0N  NN( lOl).P(5O.5O),F0RT(5C.5O).TRYaN(5O.5O).Hl(5O.5O)  HLUM0780 

DIMENSiaN  H2( 50.50 )  .OTM{50.50)  .G(50.l  )  .W(50, I  )  HLUM0790 

KM=2«LA-3  HLUM0800 

00  5  11=1, KM, 2  HLUMOaiO 

CALL  INVERT(t-2.0TM,Ll  )  HLUM0a20 

CALL  MTMPY2(L1  .QTM.Ll .«. 1  .G)  HLUM0830 

CALL  MTMPY 1 ( QTM.Hl  .2,Ll,L  1  )  HLUM0840 

•RITE  TAPE  2. (G( I , I ) , t =1.L1)  HLUM0850 

WRITE  TAPE  2,  (  (Hl(  I ,J)  .1  =  1  ,LI  )  . J=l ,LI  )  HLUM0860 

00  2  1=1. L2  HLUM0870 

G(I.1)=TRY0N(I,IJK)-G(I.1)  HLUM0880 

00  2  J=1.L2  HLUMOe^O 

2      QTM(  I . J)=F0RT(  I. J)-H1  (  I  . J)  HLUM0900 

IJK=IJK*1  HLUM0910 

CALL  HIP(L2.L3)  HLUM0920 

L1=L2  HLUM0930 

L3=NN( 11*5)  HLUM094C 

5      L2=NN(Il+6)  HLUM0950 

RETURN  HLUM0960 

ENO  HLUM0970 

•  LISTS  HLUM09eO 

•  LABEL  HLUM0q90 
CS0LN  BEGIN  BACKWARDS  SUBSTITUTIBN  HLUMIOOO 
C              ALL  DATA   IS  IMPLICITLV  SlflBEO  HLUMIOIO 

SUBH0UTINE  S0LN  HLUM1020 

C0MM0N  NN,P.F0WT.TMY0N.H1  .H2.CTM.G  .«(.  IJK.LMN  HLUM1030 

DIMENSI0N  NN(lOl),P(5O.5O).F0fiT(5O.5O).TRYeN(5O.5O).Hl(5O.5O)  HLUM1040 

DIMENSION  H2<50.S0).QTM(50,50)  .G(50,  I  )  .11(50,1  )  HLUM1050 

LMN=NN( 3 )  HLUM1060 

IJK=IJK-1  HLUM1070 

K=2»NN( 1 >  HLUM1080 

NN1=NN(K)  HLUM1090 

NN2=NN(K*1)  HLUMIIOO 


HLUM  -  HaUTINE  HLU  FBR  A  SPECIAL  CASE  -  FBRTRAN  II  CaDED 

NN3=NN2  HLUMlllO 

CALL   INVERT(t-2  ,QTM,NN2)  HLUM1120 

CALL  MTMPY1(QTM,VI.2.NN2,  n  HLUMI130 

00  J     1=1. NN3  HLUM1140 

H2( I . 1 )=0.0  HLUMl 150 

3      PC I.LMN)=W( I. 1 )  HLUM1160 

LMN=LMN-1  HLUMI170 

5  IF(NN1- I ) 1 ,6. 1  HLUM1180 

I  NN1=NN1-1  HLUM1190 
CALL  RECURS(NN3.NN2.NN1 )  HLUM1200 

6  IF(K-2)  7.11.7  HLUM1210 

7  NN2=NN3  HLUM1220 
K=K-2  HLUM1230 
NN1=NN(K)  HLUM124C 
NN3=NN(K+1)  HLUM1250 
DB  a  1=1. NK3  HLUM1260 
t-2(  I  .  1  )=*(  1  .  1  )  HLUM1270 

a      HI (  I .  1  )=M(  I.  1  )  HLUM12eO 

BACKSPACE  2  HLUM1290 

READ  TAPE  2.  (  (QTM(  I . J)  . I  =  I  ,NN3)  , J=l  .NK3)  '                           HLUM1300 

BACKSPACE  2  HLUM1310 

CALL  MTMPY 1 (QTM.Hl ,2.NN3. 1 >  HLUM1320 

BACKSPACE  2  HLUM1330 

READ  TAPE  2. (»( I . 1 ) . I=1.NK3)  HLUM1340 

BACKSPACE  2  HLUM 1 350 

00  12  1=1. NN3  HLUM1360 

W( I . 1 )=W( I . 1 )-Hl ( I , 1 )  HLUM1370 

12     P{  I  .LMN)=«f  (  I  ,  1  )  HLUM1380 

LMN=LMN-1  HLUM1390 

IJK=IJK-1  HLUMIAOO 

C0  T0  5  HLUM1410 

II  RETURN  HLUM1420 
END  HLUMM30 

»       LISTa  HLUM144C 

•       LABEL  HLUM1450 

CRECURS       RECURSI0N  IN  SUBSTITOTIBN  HLUM1460 

SUER0UTINE  RECURSC^Ml.MMa.VMS)  HLUM1470 

C0NM0N  NN.P,F0RT,  TRY0N,H1  .H2.CTM  ,G  .K.IJK.LMN  HLUM1480 

CIMENSI0N  NN( lCl),P(5O.5O).F0fiT(5O.5O).TRYaN(5O.5O).Hl(5O.5O)  HLUM 1490 

D1MENSI0N  H2(50.50  )  .0TM(50.50)  .G(50.  1  )  .»l(50.  1  )  HLUM1500 

G0  T0  2  HLUM1510 

1      00  7  1=1, MM2  HLUM1520 

HLUM1530 

HLUM 1540 

HLUM1550 

HLUM1560 

MMl , 1 )  HLUM1570 

D0  10  1=1. MMl  HLUMlsaO 

*(  I  .  1  )=TRY0N(  I  .  UK  )-*(  I  .1  )-H2(  I  ,1  )  HLUM 159  0 

P{  I.LMN)=«(  I ,  1  )  HLUM1600 

IJK=IJK-1  HLUM1610 

LMN=LMN-1  HLUM1620 

IF(MM3- 1  )5.6.5  HLUM1630 

MM3=MM3-1  HLUM1640 

G0  T0  1  HLUM1650 
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7 

H2(  I.  1  )=H1(  I  .1  ) 

MM2=MM1 

2 

00  3  1=1. MMl 

3 

Hl(  I,  1  )=<tH   I.  1  ) 

CALL  MTMPY1(F0RT 

HLUM  -  R0UTINE  HLU  F0n  A  SPECIAL  CASE  -  FBRTRAN  II  CflOEO 

6  RETURN  HLUM1660 
END  HLUM1670 

•  LISTa  HLUM1680 

•  LABEL  HLUM1690 
CMTfPYl  MATRIX  HULT I  PL  ICAT 1 0N  FgR  SGLlARE  MATRICES  HLUM1700 
C  PH0OUCT  ST0RED  0VER  A  IF  MC=l.  0VEB  B  IF  MQ=2  HLUM1710 
C       IF  B  IS  A  VECT0R  Nl=l,  0THERMISE  M=NC  MLUMI720 

SUERBUTINE  M TMPY I ( A , B , MQ , NC . N I)  HLUM1730 

C0VM0N  NN. P.F0RT . TRveN »H1 ,H2 t CTM ,G tM • I JK (LMN  HLUM174C 

DIMENSieN  NN(IO1).P(5O.5O).F0RT(5O.5O).TRY0N(5O.5O).HH5O.5O)  HLUMWSO 

DIMENSI0N  f^2{50,50  )  ,QTM(  50.50)  .G<50.  I  )  .W(50.  1  )                         HLUM1760 

DIMENSI0N  A(e0.50) .b(50.S0).C<50)  HLUMJ770 

D0  6  L  1  =  1  .Nl  HLUMWSO 

G0  T0  (1.2). MO  HLUM1790 

1  I==L1  HLUMieOO 
G0  T0  12  HLUMieiO 

2  K=L1  HLUM1820 

12  00  7  L2=1.NQ  HLUM1830 
G0  T0  (13.1'*).MQ  HLUM1840 

13  K=L2  •  HLUM1850 
G0  T0  3  HLUM1860 

14  I=L2  HLUM1870 

3  C(L2)=0.0  HLUMI880 
00  7  J=1.NG  HLUH1890 
IF( A( I . J ) )4, 7. 4  MLUM1900 

4  IF(H( J.K  )  )5.7.5  MLUMlfllO 

5  C(L2 )=A( I. J)«B( J,K)+C(L2)  HLUMI920 

7  C0NTINUE  HLUM1930 
G0  T0  (e,9).MQ  HLUM1940 

8  00  II  J=1.NQ  HLUM19S0 
11     A( I, J)=C( J)  HLUM1960 

G0  T0  6  HLUM1970 

9  00  10  J=1.N0  HLUMI980 

10  B(J.K)=C(J)  HLUM1S90 

6  C0NTINLE  HLUM2000 
RETURN  HLUM2010 
END  MLUM2020 

•  LISTS  HLUM2030 

•  LABEL  HLUM2040 
CMTMPV2       0HOINAHY  MATRIX  MULT IPL I C A T I «N  HLUM2050 

SUeR0UTINE  MTMPY2(K,A.L.B,KM.C  )  HLUM2060 

C0VM0N  NN.P,FaMT.TRY0N.HI  .H2.CTM ,G  .■. I JK.LMN  HLUM2070 

OIMENSIBN  NN(1O1).P(5O,5O).F0BT(5O,5O).TRY0N(5O.5O).H1(5O.5O)  HLUM2080 

OlfENSIBN  h2(50.50  )  .OTM(50.50)  .G(50.I  )  .>»(50.1  )                         HLUM2090 

CIMENSI0N  A(50.50) .B(50.50).C(50.50)  HLUM2100 

00  2  I  1= l.K  HLUH21  10 

00  2  12=1. MM  HLUM2120 

C(  I  1.  I2)=0.0  HLUM2130 

00  2  13=1. L  HLUM2140 

IF( A(  I  1.  13 )  )3.2.3  HLUM2150 

3  IF(e( 13. 12 ) )4, 2.4  MLUM2160 

4  C(  I  1 .  12) =A(  I  1.  I3)«B(  13. I2)*C (  I  1  . 12)  HLUM2170 
2              CBNTINUfc  MLUM2180 

RETURN  HLUM2190 

END  HLUM2200 
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HLUM  -  R0UT1NE  HLU  FAR  A  SPECIAL  CASE  -  FflBTHAN  II  C0OEO 

LIST8  HLUM2210 

LABEL  HLUM2220 

JVEHT       MATRIX  INVERSE  HLUM2230 

SUERauTINE  INVERU A.B.NX)  HLUM2240 

C0yM3N  NN,P,FaFlT,TRY0N,Hl  ,M2.CTM,G,»t.IJK,LHN  HLUM2250 

DIMENSIHN  NN(  101  )  ,P(50.50)  .F0BT(5O,5O)  .TRY0N(5O.5O).H1(5O.5O)  HLUM 2260 

DIMENSI0N  H2(50.S0 ).QTM(5C,50) .G(5C. I ) ,W(50. 1 )  HLUM2270 

D1MENSI0N  A(S0.50),B(50,50)  HLUM2280 

00  1  1=1. NX  HLUM2290 

00  1  J-l.NX  HLUM2300 

IF(l-J)2.3.2  HLUM2310 

e(I.J)=0.  HLUM2320 

G0  T0   1  HLUM2330 

B( I. J )=1 .0  HLUM23A0 

C0NTINUe  HLUM23S0 

IA=XL0CF(A(1,1) )-XL0CF{A( 1.2))  HLUM2360 

IB  =  XL0CF(O(1,1)  )-XL0CF<B(  1.2)  )  HLUM2  370 

CALL  LEO(A.B.NX.NX.IA.IB.CET)  HLUM2380 

RETLRN  HLUM2390 

£^,Q  HLUM2400 
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Identification:   SQUID  -  Quldlagonal  Matrix  Routine 

7090  PORTRAN  Source  Language 
Purpose:   To  solve  the  matrix  equation 
Qv  =  g 
where  Q  Is  a  quldlagonal  matrix  with 
scalar  elements. 


^1    % 
B2   C2 

^2 

0 

A5    B^ 

=5 

D3   E, 

0    A^ 

B4 

O4    D4    E^ 

0    0 

*5 

B5    C5    D5    E3 

0 

A   T  B   .  C   .  D   , 
m-1   m-1  m-1   m-1 

\   ^m   ^m 

Method:    Q  Is  first  factored  Into  LU  as  In  HLU  and  Uv  Is 
set  =  h.   Then  Lh  =  g  and  Uv  =  h  are  solved 
respectively.   The  following  elimination  scheme 
Is  used 


^1 
and 


6  .  =  B. 
J    J 


^1/^1  ^ 


D^/co-L 
--   0 


'm-1 


^rj-2 


^J  -  Vj-2 


^/j-1 


then  the  forward  sweep. 


0   h^  =  s^A^i 


j  =  2,3. 


2, 


-  I4s  - 


and  the  backward  sweep, 

V  =  h 
m    m 

"J=  '^J-f'j^J+l  -  ^jV2         J  =  m-l,...,2,l. 

Usage:     The  five  diagonal  vectors  A,B,C,D  and  E  must 

be  stored  as  shown  although  It  Is  not  necessary 
to  set  ^1=^2=  0,  etc.   The  calling  sequence  is 

CALL  SQUID  (A,B,C,D,E,V,G,0M,BET,GAM,DEL,M) 
where 

A,B,C,D,E  are  the  given  diagonal  vectors 

V   is  the  solution  vector  of  dimension  M 
G   is  the  given  vector  (right  hand 
side)  of  same  dimension 
0M, BET, GAM, DEL  are  erasable  buffer  areas,  each 
of  dimension  M 
M   is  order  of  Q. 
Requirements : 

Storage: 

353o  =235^Q  locations 
Timing :    Approximately  2.3  x  M  ms . 
Author:   William  R.  Becker 
Date:   August  I962 


1^^ 


SQUID  -  OLIDIAG0NAL  MATRIX  R0UTINE  -  FBRTRAN  II  C0CEO 


CSQtIO  SQUIOOIO 

C       SUBRacTINE  T0  SBLVE  A  QUIDIAGeNAL  SYSTEM  eF  EOUAT10NS  SQUI0020 

SueR0UTINE  SQUID  ( A , B . C i O .F . X . Y . 0M .BET .GAM . CEL i K )  SQUID030 
DIMENSI0N  A(S).B(S>.C(S).D(S).E(5).X(S).Y(S).0M(S).BET(5).GAM(5).  SOU  I  004  0 

ICEL(5)  SQUIDOSO 

0M=C  SQUID060 

BET=C/0M  SQUID070 

0EL(2)=B(2)  SQUIDOSO 

0M(2)=C{2)-DEL(2)«BET  SQU1D090 

00  5  1=3. N  SQUIOIOO 

GAMt  I-2)=E (  1-2  )/0M(  1-2 )  SQUIDIIO 

BET!  I-l  )  =  (C«  I-  1>-DEL( I-l  ) 'GAMC I-2))/0M(I-l)  SQUIDIZO 

DELI  I  )=a(  I  )-A<  I)»BET(I-2)  SQUID  I  30 

00C5  0M(  I  )=C(  I  )-A(  I  )»GAM(  I-2)-CEL(  I  >«BET<I-I)  SQUI0140 

X=Y/0M  SQUI0150 

X( 2)=( Y(2)-DEL(2)»X)/0M(2)  SQUID160 

00  7  1  =  3, N  SQUIOI70 

00C7  X(  I  )  =  ( Y(  I  )-OEL ( I  )«X(  I-l)-A( I  )«X(  I-2))/0M( I  )  SQUIOI80 

X(N-1)=X(N-1)-X(N)»BET(N-I)  SQUID190 

00  <9  1=3. N  SQUID200 

K=N-I+1  SQUID210 

00C9  X(K)=X{K  )-UET(K)»X(K+l  )-GAH(K)«X(K*2)  SQUID220 

RETURN  SQUID230 

ENC  SQUID240 
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Identification:   TRIQ  -  Modified  Quasl-Trldlagonal 
Matrix  Routine 

7090  FORTRAN  Source  Language  Routine 
Purpose:   The  program  solves  the  matrix  equation 
Qv  =  g 
where 


Method; 


Usage: 


H   E 
D   H   E 
D   H 


O 


O 


D   H   E 
D   H 


D,  H  and  E  are  square  matrices  and  v  and  g 
are  vectors. 

The  method  of  the  more  general  program,  HLU, 
described  In  NYO  Report  2542,  "Quasl-Trldlagonal 
Matrices  and  Type-Insensltlve  Difference  Equations, 
by  Samuel  Schechter,  Is  used  with  some  simplifica- 
tions.  There  Is  no  tape  usage  by  the  program. 
Routine  Is  entered  by 

CALL  TRIQ(D,H,E,V,G,Y,A,N,M,K) 
where 

D         =  matrix  on  lower  diagonal 
H        =  matrix  on  main  diagonal 
E         =  matrix  on  upper  diagonal 

V  =  solution  vector  of  dimension  N  x  M 
G         =  given  vector  of  same  dimension 

Y  =  erasable  buffer  area  of  same  dimension 
A         =  buffer  area  of  dimension  (M+l)  x  N 

Into  which  M  matrix  Inverses  will  be 
stored.  If  the  user  wishes  to  avoid 
recomputatlon  of  these  Inverses  upon 
re-entry  to  TRIQ,  K  Is  given  as  =  2 . 
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nMiti|iw1wfa  K   1-S  gl-v&n  -   X  a,nr|  A  muy  be 
ui'fct,Mfc<(1.        Ill    bl  MiHi'    rjttlifi    l.liH    rifi/i,  I    iT 
wni'dw   i-r'  A   tti'fa   er'ttfitt|jJ-M.      A,    uikI    II      may 
jjfa    Uio   Mttifiti   .|.(iat).l-l.fiM    l/iil.    l.liH   (iflKl'iu]    II 
i(ifc(,l,i'lH    Im   riol,    r'eMtnr'nd    In    I.IiIm    <'h.t\(i. 

II  -    Uifci    (jprjei:'    of    t.lib   iiittl.i'li^hH    |i,    11    niirj    I'!. 

|V|  -    MiH    MiiiiihHi'    nf   iiirtti'l  (iHii    Mil    i.iif,    iii;i1ii    (Mn,p;"ii/i  I  . 

K  -     I     1  r     li,«/nni..|i    firn    1,(.    Imi    (■m||1|,iiI,,.(| 

-     I'     (.Mlt-U'WlMii 
A(Kl||l'tti;y  I      Ttlln      lH     (|ti|iti|ll|ii|il      nil     llin     liifill'll^Hh     |),      II     (IIKJ     I'!    IllMi-c 

Mitui   I'll    Mm   iiiiiiihtir  M ,      ji'ii  II    ; ;  ii.l.fcton  aooupaoy   wao 

ull'H.liiiiil    iiiilii|i;    |i  -    I'l   Mil. I    h,    II,    p;    t/i'1(1l,'i,p;iiiwil  , 

Wlinl'ti  |V|  -  '). 
'iMiiilitt;;!         Ajti'iMi.K  liiittl  nl,v    (Mll)'<(Miiin    i'mi-    I,I'X,i    1.1.    lnvfi'l.    on 

N»N  uiHtivln)  . 
ito<lU.j.l.'U!lltJll|.M  I 

IWll'Y,     IPI'iNT.    I.AXM,    I.ICQ 

wliPi'tJ    lil'lm    \ti   n   I'oiiMnn    that    will    tuvlvo  h   nynteni  of 
n  limi  1 1  UMPPUH   .l..Vnt)tt.i'  t^quat.  lonn,    llM'lN'r  will    ^.-.t'luvrate 
au    ldt)ullty  mutrlx   of  yilvt^n  oiHlni'.    ami   h'MMl'Y  will 
foiMU   t.|\0  matrix  pi'oduut    of   two   h\M\'n\AN   IT  vHi'i^iya. 
'flio   routluti   t'WU'V   oallh    l\w  rout  l.Mt>  IJVXM  which 
will    oauHt>   t  l\ti  Y^^^^^l    to  t^utt^r  aUtlltloual   Index  mode. 
'Hi In    iHMit  l»\c>  HhoulU  not.   bv  ut^t^d   If  the  machine  la 
In   ti-auHfei'   t  vaVH''l>>e  >«^'^<*^«      KUhec  olngle-pt'eclalon 
v*ii'Hlo»^  or  14'XJ  listed   In   thla  I'epoi't    will   t^atlat^ 
the   rtJ^ulvwuentrt   of  TKIQ.      l.latlnji;a   of  IPKNT,    FMMPY 
«»\d  liAXM  ave  given  without    fuether  wi'Ue-up    t\^llow- 
In^   the  llytlug  of  'mx^, 

K^K^v       ^   l^^-^-K;  Iwatlona  plvia   the  x'e^julred 
avitviwitluea  ll9t©d   In  a). 
■•Vuchoi'}        Ws   K,   kWoKer 
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I0CIFIEO    QUASI-TRIOIAGeNAL     ^"ATRIX     RBtlTINE     -    F0RTRAN     II     C0OED 


OOCl 

ooc? 


SUBR0UTINE  T0  S0LWE  A  QU A S I - T fi I  0  I AGBN AL  SYSTEM  OF  EOUATIBI 

THE  MATRIX  Q   IS  PARTITI0NEC  IKT0  A  TRI-OIAGBNAL  MATRIX  «I 

CBFFFICIENTS  UN  A  OIAG0NAL  ALL  EQLAL 

CALL  TR  IG(  CM. E.V.G.  Y.A.N. M,K  ) 

C=MATRIX  0N  L0*ER  DIAG0NAL 

C=MATRIX  0N  MAIN  OIAG0NAL 

E=MATRIX  0N  LPPER  DIAG0NAL 

V  =  S0LUTI0N  VECT0R  ( 0  I  MENS  I eN  =  ^ 'M ) 

G=GIVEN  VECT0R  0F  SAME  DIMENSIBN 

Y=ERASEAPLE  BUFFER   AREA  0F   DIMENSION  N«M 

A=HUFFER  AREA   0F  DIMENSIBN  N»S«(M*1)   INT0   WHICH  M  MATRIX 

*ILL  HE  ST0RED.  IF  THE  USER  WISHES  T0  AV0IO  REC 0MFUT AT  I BN 

INVERSES  UP0N  RE-ENTRY  T0  TRICK   IS  SET  =  2    0THERWISE  K  IS 

AND  A  MAY  BE  ERASED. 

N=THe  aRCER  0F  THE  MATRICES  D.M  ANC  E. 

M  =  Tt-E  NUMBER  0F  MATRICES  C  0S  THE  MAIN  DIAG0NAL 

K=l   IF   INVERSES  ARE  T0  BE  CBMFLTEC 

=2   IF  N0T 
THIS  PR0GRAM  INCLUDES  THE  SLBR 0UT I NES .LEO. I DE NT  AND  FMMPY 

SUBRHUTINt  TRIQ(D.C.E.V,G.Y.A,NN,y.KT) 
OIMENSI0N  C(10).C(10).E(IC).V(5).G(5).Y{5).A(50) 

N2=N»N 
NA=N2+ 1 


G0  T0  ( I .50) .KT 

A( 1 )=C 

D0  2  K=I .N2 

A{K>=C(K  ) 

C0MPUTE   IDENTITY  MATRl 

CALL   IDENT( A{N2M+1 ) .N) 

A(  I  )  =A(  1  )- INVERSE 

CALL  LEQ(A.A(N2M*l ) .N.N.N.N.DET) 

D0  3  L=l .N2 

LP=N2M4L 

AIL  )  =  A(LP ) 

MAIN  L00P  T0  C0MPbTE  A(I)-INVERSe 

D0   10  K=NA,N2M.N2 

KM1=K-N2 

A(M+  I  l=A(K-l  )•£ 

CALL  FMMPY(A(KM1).E.A(N2M♦I).^.N.^.^.^.^ 

A(K  )=C»A(M»I  ) 

CALL  FMMPY(C.A(N2M+I).A(K).N,N.N.N.N.N> 

A(K  )=C-A(K  ) 

00  5   J=l .N2 

I=K  +  J 

A(  I-l  )=C(  J  )-A(  I-l  ) 

A(K)=A(K )- INVERSE 

CALL  IDENT (A(N2M+ I ) .N) 


IN  A(M*1 ) 


TR IQOOIO 
TR  IQ0020 
TW 100030 
iS.CV=G.  TRIQ0040 
H  MATRIXTR 100050 
TR IQ0060 
TR 100070- 

TR loooeo 

TR 100090 
TR lOOlOO 
TR 1001 10 
TR 100120 
TR 100130 
NVERSES  TRIOOIAO 
0F  THESETM 100150 
SET=1  TRIQ0160 
TR 100170 
TR 100180 
TR 100190 
TR IO0200 
TR IO0210 
TRIQ0220 
TR  IQ0230 
TR  I0024C 
TR 100250 
TR  1002610 
TR  100270 
TR 100260 
TR 100290 
TR 100300 
TR lOOllO 
TR  100320 
TRI00330 
TR  I0034C 
TR IQ0350 
TR 100360 
TR 100370 
TR  IQO3B0 
TR IQ0390 
TH  lOOAOO 
TR lOOAlO 
TR  100420 
TR  100430 
TR IOO440 
TR 100450 
TR 100460 
TR IO0470 
TR 100460 
TR 100490 
TRIQ0500 
TR  100510 
TR 100520 
TR  IOO530 
TRIO0540 
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M0CIFIEO  QUASI-TRIOtACeNAL  MATRIX  R0UTINE  -  FBRTRAN  II  CBOEO 

I  TRIQ0550 

TRIQ0560 
THIQ0570 
TR 100580 
TRIQ0590 
TRtQ0600 
TRIQ0610 
TRI00620 

,A(M).  CeMPUTE  Y(1)...Y(M)  TRIQ0630 
TRIQ0640 
TRIO06S0 
TRIQ0660 
TRIQ0670 
TRIQOeeO 
TRIQ0690 
TRIQ0700 
TRIQ0710 

.I.N. N.N)  THIQ0720 

TRIQ0730 
TRIQ0740 

^.N.N)  TRIQ07S0 

THIQ0760 

KyY=KY*N-l  TRIQ0770 

Ca  eO  J=KY.KYY  TRIO07a0 

Y< J)=G( J)-Y( J)  TRIQ0790 

OOtO  C0NTINUE  TRIQ0800 

TRIQOeiO 
TR  IQC820 
TR 100630 
TR IQ084C 
N.N)  TRIQOaSO 

TR100860 
TRI00870 

TR  looeeo 

TR  IQ08<30 
TRI00900 
TRI00910 
TRIQ0920 
TRIQ0930 

KY=NMI+J  TRI0094C 

OOtS  Y(KY-1  )  =  Y(KY-I  )-V(KY-l )  TRI004SO 

CALL  FMNPY(A(N2Mli 1 ) ,Y(NM1 ) .V(NM1 ) .N.N.I .N.N.N)  TR100960 

0070  C0NTINOE  TRIQ0970 

HETLRN  TRI00980 

END  TRI00990 


CALL  LEO(A (K) .A(N2M»1 )  .N.N. N.N.I 

D0  10  L=I.N2 

LP=N2M*L 

LK=K»L 

A(LK-1  )=A<LP) 

0010 

c 

c 

C0NT INUE 

FflRWARD  SliEEP 

c 

INVERSES  ARE  N0M  ST0REO  IN  All) 

c 

Y(  I  )=G(  1  ) 

0050 

D0  55  K=I,N 

Y(K)=G{K) 

ooes 

C0NTINLE 

c 

Y(K)=G(K)-C»A(K-l)»Y(K-l)      *• 

KY=l 

C0  60  K=1.N2K1.N2 

c 

A(M> 1  )=A(K-1  )»Y(K-1  ) 

CALL  F|i«MPY(A(K),Y(KY).A(N2M+I  ).l 

KY=K  Y-fN 

c 

Y(K)=D«A(M*1 ) 

CALL  FMMPY (0,A (N2M*1 ) , Y(KY) ,N,N 

c 

Y(K  )=G(K  )-Y(K  ) 

BACKWARD  SOEEP 

V(M)=A(M)»Y(M) 

NMl=N«M-N* 1 

CALL   FMMPY(A( 

N2M1* 

1 ) .Y(f 

<IM 

1  )  . V(N 

HI) 

.N.N 

V(K)=A(K)«(Y( 

K)-E» 

V(K+l) ) 

F0R  K 

=  M- 

1  ..  . 

V(K)=E«V(K+1  ) 

l.YtK) 

=  Y(K)- 

-V 

(K) .V( 

K)  = 

A(K) 

00  70  K=2.M 

KV=NM1 

N2M1=N2MI-N2 

CALL  FMMPYIE, 

1  V(KV) 

.V(NM] 

1  > 

.N.N.I 

.N. 

N.N) 

D0  65  J=1.N 
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SCBRfitTING     T{ 


iTRIX     -     FAF     C0CEO 


lOENT  SXA 


SLBR4»UT1NE  TPI  Ca^FtTe  THE   IDENTITY  VATBIX. 
CALL( A.N ) 
A^NXN   ARRAY 
ICENT 

1 


ACC 

ICCCOCO 

3TC 

+ 1 

STZ 

.  1 

T  I  X 

.1.1 

CLA 

12C110CC00CC0 

STU 

••2 

T  IX 

=.2.»« 

IDENTOIC 
IDENTC20 
I0ENTC30 
IDENTCAC 
IOENT050 
IOENTC60 
10ENTC70 
IDENT080 
IOENT090 
IDENT 100 
IDFNT  1  10 


IDEf 


120 


IDENT130 
IDENT 14C 
IDENT  150 
lOENT 160 
IDENT 170 
IDENTieO 
IDENT 190 
IDENT200 
IDENT210 
IDENT220 
IDENT230 
1DENT20C 
I0ENT250 
IDENT26C 
IDENT270 
I0ENT2eC 


N0  SI 

i 

NlDAHD  ERRBR 

FAP 

MMPY 

MATRI X  PR 

PCC 

LBL 

WNPY. X 

ENTRY 

XWMP 

ST2 

XW 

<!ET 

FM 

TRA 

VMPY 

STL 

FS- 

CLA 

FfP 

5TC 

Me*  1 

CLA 

FRN 

ST0 

Me*2 

CLA 

FAD 

STC 

ft*3 

CLA 

ACQ 

STD 

Me  +  3 

CLA 

XJ*  1 

STL" 

t<LAXR) 

THA 

» (LAXM) 

CLA 

EMTV 

LMTM 

STB 

X£ 

F^IRTRAN  MATRIX  ^'ULTIPLY  RBOTINE  -  FAP  CBCEC 


MMPYOOIO 

MMPY0020 

0CUCT  SL8R0LT1NE  KMP YOO 30MMPY 0030 

MMPY004C 
MMPY0050 

138  HIMPY0060 

SLBR0UTINE  T0  F0BV  THE  FBRTRAN  MATRIX  PR0OUCT  MMPY0070 

A»B  =  C    THE  SUBRBIjTINE  HAS  2  ENTRY  P0INTS  MMPY0080 

F^'MPY,F0R  FLBATING  PT.  ARITHMETIC  MMPY0090 

XMMPY.FBH  FIXCD  PT.  ARITHMETIC  MMPYOIOO 

CALLING  SEQLENCE=  MMPYOilO 

CALL  FMMPY( A.R.C .NRA .NCABB.NCe.NA.NB.NC)  MMPY0120 

HR  FAP  EOLIVALENT.  MMPY0130 

A=1ST  W0nD  BF  LEFT  MATRIX  FACT0R.  MMPV0140 

H=:1ST  W0RD  0F  RIGHT  MATRIX  FACT0R.  MMPY0I50 

C=lSt  IK0RO  0F  MATRIX  PR0CLCT.  MMPY0160 

NHA=N0.   0F  R0\«S   eF   A.  MMPY0I70 

NCARB=N0.  0F  C0LS.  0F  A=Ne.  0F  Re»S  0F  B.  MMPYOIBO 

NCB=N0.  BF  C0LS.  0F  E.  MMPYOI90 

NA=1ST  SLBSCWIPT  IN  A  DIMENSIBN  STATEMENT.  MMPYC200 

NG=1ST  SUBSCRIPT  IN  E  DIMENSIBN  STATEMENT.  MMPY02I0 

NC=IST  SUBSCRIPT  IN  C  OIMENSIBN  STATEMENT.  MMPY0220 

SENSE  LIGHT  I   IS  TURNED  BN  IF  FIXED  P01NT  MMPY0230 

0VERFL0W  HAS  BCCURREC.  MMPY0240 

MMPY0250 
FMMPY  MMPY0260 

MMPY0270 

MMPYC2e0 

MMPY02<JC 

MMPY030C 

MMPY031G 

MMPY0320 

MMPY0330 

MMPY034C 

MMPY0350 

MMPY0360 

MMPV0370 

MMPY0380 

ZER0  FL0AT.  FLAG  MMPY039C 

TEST   IF  CBRRECT  MBCE  MMPYOAOO 

YES.  MMPY0410 

NB.  NBN-ZERB  FIX.  FLAG  MMPY0420 

MMPY0430 

MMPY044C 

MMPY0450 

MMPY0460 

MMPY0470 

MMPY0480 

MMFY0490 

27NUMMPY0500 

27NUMMPY0510 

27NUMMPY0520 

ENTER  7094  7  INCEX  REGISTER  M0OE.  MMPY0530 


ZERfl  FIXED  PT.  FLAG 

TEST  IF  ARITH.  MBDE 

IS  C0RREC 

YES. 

NB.  NBN-ZER0  FLBAT. 

FLAG 

'054C 
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F0RTRAN     M*TRtX     MIjLTIPLV     RBUTINE 


FAP  C0OEC 


sue* 

STC 
CLAi 
STC 
CLA< 
STC 


ALS17  ALS 


X  1  .  1 
X  !♦  1  .2 
Xl+2.  3 
XI +3.5 

x\*i,e 

X  1  +  5.  7 

H  1 


TNa 

•♦2 

SLN 

1 

THA 

10.4 

REM 

INI TIALIZ 

TUV 

•  +  1 

CAL 

1  .4 

ACC 

A  1 

STA 

yt 

PtT  SENSE  LIGHT  1  ( 
IF  INTEGER  avERFLBV 
RETURN 


ShLT  KFF  0VFL*  LIGHT 


NCARB-NB 


INI T I ALI ZAT  K 


1  +  1  .7  c 

«e,7 

1  .3 


NCARB+ J-1 
SET  TEST 


MMPY0550 
MMPY0560 
MMPY0570 
MMPY058C 
MMPY0S90 
MMPY0600 
MMPY0610 
MMPY0620 
MMPY0630 
MMPY064C 
MMPY0650 
MMPY0660 
MMPY0670 

MMPYoeeo 
MMPYoego 

MMPY0700 
MMPY0710 
MMPY0720 
MMPY0730 
MMPY074C 
MMPY0750 
MMPY0760 
MMPY0770 
MMPY07eO 
MMPY0790 
MMPY0800 
MMPYOaiC 
MMPY0a20 

MMPYoaso 

MMPY0e4C 
MMPY0850 
MMPY0860 
MMPY0870 

MMPYoeao 

MMPY0890 
MMPY0900 
MMPY0910 
MMPY0920 
MMPY0930 
MMPY09AC 
MMPY0950 
MMPY0960 
MMPY0970 
MMPY0980 
MMPY0990 
MMPYIOOO 
MMPY 10  10 
MMPY 1020 
MMPY1030 
MMPY1040 
MMPY1050 
MMPY1C60 
MMPY 1070 
MMPYlOeO 
MMPY 1090 
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'PY     -     F0P 


'ULTIPLY     RULiTINE     -    PAP    CBCeO 


STZ 

LCC 


FV 

P^E 

xw 

PZfc 

FMP 

FVP 

FRN 

FWN 

FAi: 

FAC 

MPy 

MPY 

EMIM 

tMTW 

ENC 

1 .1 

3  .  I 


C(K)=C 
A(KA) 
e  (KB  ) 

C (K )=C (K) +A( KA )«e (KH) 


is  KB  GRTH   THAN  NCARH*J-1 

YES.   K=K+1 

I=I*1 

IS  I  GRTR  THAN  NRA 

YES.  J=J+NH 

tS  J  GRTR  THAN  NCK»N8 

YES.  SETUHN 

K=K+NC-NHA,LeeP     BACK. 


MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 
MMPY 


MM  PI 
MMP^ 


MMP> 

MMP1 


MMP1 
27NUMMP^ 


1110 
1120 
1  130 
1  I4C 
1  150 
1  160 
1  170 

1  leo 

I  190 
1200 
1210 
1220 
123C 
124C 
1250 
1260 
1270 
1280 
1290 
1300 
1310 
1320 
1330 
1340 
1350 
1360 
1370 
1380 
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'LLAT10N  0F  LAXK  INSTRUCTIet 


FAP  C0CeC 


N0  STANDARD 

FAP 

R0L, 

PCC 

C0LNT 

34 

LBL 

NLL 

HE  7C90'S  L/ 


HE  CALLING  SEGLENCE 


THIS  R^tTINE  IS  AS  FKLLewS 


LAXMOOIO 
LAXM0020 
0030LAXV0030 
LAXM0C4C 
LAX^'0050 
LAXM006C 
LAXK0C70 
•  LAXMOOeC 
LAXMOCSC 
LAXMOIOC 
LAXMOl 10 
LAXM0120 
LAXM0130 


RN 

1 

RETLR 

UN 

2 

RETLR 

RESTR 
IS   IN 

XR2 

2 

XR3 

3 

C.2 

iILL  BZ     fADE  HERE   IF  NACHINF  WAS   IN  ^' T  K0DE 
iILL  EE  f'ADE  HERE  IF  ^'ACHI^E  WAS   IN  AXR  MUDE 


ICTI0NS..  THIS  fi^LTIKE  Wl 
TRANSFER  TRAPPING  ^'eDE. 


FAIL  IF  THE  MACI 


IS      A      M?F     FeF 


LAx^'0^50 

LAXMOieO 
e  LAXM0170 
LAXMO 18C 
LAXIJ019C 
LAXMC200 

LAx^'c^lC 

LAXM0220 
LAXN0230 
LAXM02*C 
LAXW025C 
LAXy026C 
LAXM0270 
LAXM02eC 
LAXW029C 
LAXW03CC 
LAX^'03  IC 
LAXM0320 
LAXN0330 
LAXN03AC 
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Identification:   BLEQ  -  Band  Linear  Equations 
FORTRAN  II  Coded  709^ 

Purpose:   To  solve  the  matrix  equation  a^^^^^  ^{nxp)    ^   ^(nxp) 
v;here  n  Is  large,  available  storage  locations  are 
few,  and  A  has  the  band  property:   there  Is  a 
non-negative  Integer  m,  much  smaller  than  n, 
such  that  A(l,j)  =  0  for  | 1-j |  >  m.   However, 
the  program  will  work  If  n  Is  not  large,  or  If 
the  m  selected  Is  not  small. 

Method:*   Equilibration,  and  Gauss  elimination  with 
column  partial  pivoting. 

Input:    A  may  be  transmitted  to  BLEQ,  along  with  the 

Information  that  m  =  n-1.   However,  A  need  not 
be  present  in  storage.   Generally,  an  array  B 
will  be  transmitted  having  dimensions  _> 
(n  X  min(2m+l,n) ) .  The  2m+l  diagonal  stripes 
in  the  band  of  A  do  not  correspond  to  the 
columns  of  B  (unless  m  =  0) .   Instead,  push 
the  band  elements  in  each  row  of  A  to  the  left 
until  they  occupy  the  first  positions,  and  then 
store  the  first  columns  of  this  matrix  in  B. 
The  first  rows  and  the  last  rov;s  of  A  usually 
have  fewer  than  min(2m+l,n)  band  elements. 
In  such  cases,  the  remaining  positions  at  the 
ends  of  the  first  rows  and  the  last  rows  of 
B  may  be  left  unspecified,  since  BLEQ  will  set 
them  to  zeros. 
Example:   The  system  of  equations 

a-j^x^  +  agXg        =   y-|_ 

b^x^  +  bgXg  +  b^x^  =  yg 

c^x^  +  CgX^  =  y^ 

may  be  written  as  AX  =  Y  where 
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A  = 


For  this  A,  we  may  choose  m  =  1  or  2. 
If  m  =  1  is  selected,  then 


where  *  =  arbitrary;  BLEQ  sets  these  positions 
to  zero.   In  this  case  B  corresponds  to  writing 
the  system  in  the  form 


c^x^ 


^1 
^2 


If  m  =  2  is  selected,  then  A  and  B  are  Identical 
End  of  example. 


The  following  formula,  equivalent  to  the  fore- 
going descriptions,  defines  B.   For  each  1=1 
2,...,n,  let  ^qCI)  =  min(m+l,m+n-i+l,2m+l,n) 
and  let  k-,(i)  =  max(0, 1-m-l)  .   Then,  for  each 
k  =  1,2,  ...,kj^(i). 


B(i,k)   =  A(i,k+k^(l))  . 

Usage:     CALL  BLEQ(B,N,M,PIV,DET,R,K) 
The  input  arguments  are 
B      storage  area  for  the  band  of  A 
N      number  of  rows  of  B  (=  order  of  A),  N  >  1 
M      A(i,j)  =  0  for  |i-j|  >  M,  0  <  M  <  N-1 
R      right  hand  sides  columnwise  (=  N  x  N 

Identity  in  order  to  find  A~  ) 
K      number  of  right  hand  sides,  K  _>  1 
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The  output  arguments  are 

R      containing  the  solution  vectors 

columnwise 
Prv    the  smallest  (in  absolute  value)  pivot 

that  occurred  during  the  elimination 
DET    the  determinant  of  B. 

In  case  A  is  singular,  both  PIV  and  DET  will 
be  normal  zeros,  and  it  is  sufficient  to  test, 
say,  whether  PIV  =  0.   Arrays  B  and  R  are 
altered . 

Overflow;  The  chance  of  overflow  in  computing  the 

determinant  of  A  is  reduced  by  accumulating 
exponents  in  the  decrement  of  one  memory 
location  while  the  floating  point  fractional 
part  occupies  another.   Exponent  and  fractional 
part  are  packed  together  in  DET  just  before 
return,  providing  the  exponent  is  not  too  large 
in  which  case  DET  will  contain  377  777  777  7773  " 
0.17014118E39. 

Dimensions:  The  symbolic  cards  on  file  include  no 

DIMENSI0N  statement.   They  do  include  the  follow- 
ing comment  card: 

C    DIMENSI0N  B(N,XMIN0P(2*M-t-l,N)),R(N,K) 

The  user  replaces  this  comment  card  with  a 
DIMENSION  card  which  specifies  at  least 
N  X  min(2M+l,N)  locations  for  B,  and  at 
least  N  X  K  locations  for  R. 
References:  P.  Naur,  BANDMATRIX,  BIT  I963  (207) 
D.  H.  Thurnau,  BANDSOLVE,  Gomm.  ACM, 

August,  1963  -(441) 
McKeeman  et  al . ,  GROUT  with  Equilibration 

and  Iteration,  Gomm.  ACM,  11-62  (555). 
Requirements: 

a)  System  Built-in  Functions  (open  subroutines) 
ABS,  XABS,  XMINO,  XSIGN 
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b)  Storage 

984^Q  =  1750g  locations 


Author:    Sam  Greenspan 
Date:     December  1964 
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CLEQ  -  BAND  LINEAR  EQLATI0NS  SeLUTIBN  -  FBRTRAN  II  C0CEC 

CHLt-C   BANC  LINEAR  EQUATiaNS  /  N>U  HATH  LTILITY  /  S.  GREENSPAN  BLEQOOIO 

C       THIS  SUBHPIUTINE  IS  SERIALIZED  FRgM  BLECOOIO  TB  eLeCieSO BLEQ0020 

CREFERENCES...P.NALR.OANCMATniX.BIT .1962.PAGe  207  BLEO0030 

C                                           C.H.THljRMAN.BANDSeLVE  ,CACK,  1963. PAGE     44  1  BLEQ004C 

C                                           ^'CKEE^'AN.CR0LT.CAC^'.1562.PAGE353  BLEQ0050 

SUHRKUTINE  BLEGCH.NB.MH.PI VB.CETB.R.KR)  BLEQ0060 

CTHE  F0LLa*ING  CafVENT  CARD  SHatLD  PE  CHANGED  T0  A  OIKENSI0N   CARD.  BLFQ0070 

C       CIVENSiaN  D(N, XMIN0F(2»M*I  ,N)  )  ,R(N,K)  BLEQ0080 

C       THE  N0TATI0N  UN  THE  PREVIKUS  CARDC0NF0RMS  T0  THE  WRITEUP  0F  THIS  BLEQ0090 

C       PR0GRAV.TH  CeNF0R^'  T0  THE  N0TATI0N  0F  THE  C0CE  aNTHESE  CARDS  BLEOOIOO 

C       *»E  SH0LLD  HAVE  T0  WHITE  AS  F0LL0»S  BLEQOllO 

C       D1MENSI0N  H(  NC .XMINOF( 2»MB+ I .^B)  )  .R(N8 .KR )  BLEQ0120 

EUCIVALENCE(EXP,IXP).(EX.IX),(EP.IP).(EC.IC).(T.IT),(ARS.IAHS).  BLEQ0130 

l(DET.IOET)  BLEQ0140 

EQUIVALENCE  (NOl.ENOl)  BLEQ0150 

e                 EivlOl  =  377777OC00OO  BLE00160 

KF=KR  BLEOOWO 

NF=NB  BLEOOI80 

yQT=We  BLEQ0190 

Me=XMINOF( 2»Me+l .NH )  BLEQ0200 

MF=MB  BLEQ0210 

IALS=2«»9  BLE00220 

H       ARS=0O0  000  OCl  000  BLEQ0230 

NE0=1  BLEQ024C 

B       EC=200  OCC  OCC  000  BLEQ0250 

IX=0  BLEQ0260 

IY=0  BLE00270 

IF(NF-l)  -i^. 43.44  BLE00280 

43  IF(6( 1 . I ) )45.b.45  BLEQ0290 

45           D0     46     J=1.KF  BLEQ0300 

46     R( 1 , J )=H ( 1 . J )/e( 1 . 1 )  BLEQ0310 

CEIE=fl( 1.1)  BLEQ0320 

PIVB=1  BLEQ0330 

G0     r0     33  BLEQ034C 

44            IF(KF-  1  )47,47. 48  BUEQ0350 

47           D0     49     1=1. NF  BLEQ0360 

F=B( I . 1 )  BLEO0370 

IF(F)50.5.50  BLE00380 

50           ASSIGN     5eT0     NJ  BLE00390 

G0     T0     60  BLEQ0400 

56           ASSIGN     49T0     NI  BLEQ0410 

G0     T0     28  BLEa0420 

4iJ     C0NTINUE  BLEQ0430 

D0     51      1=1. NF  BLE0044C 

D0     51     J=1.KF  BLEQ0450 

tl     R(  I  .  J  )=R(  I  .J )/0(  I  .  1  )  BLE00460 

SMALL=1  BLE00470 

G0  T0  £9  BLEQ04aO 

BLEQ0490 
BLEQ0500 
BLEQ0510 
BLEQ0520 
BLEQ0530 
BLEQ0S4C 

:0I .3501.3502  BLE00S50 
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NBMl=rjF- 

1 

M  =  MRT 

MPl=M+l 

00  35  1= 

1  .M 

NBMIP1=N 

F-  I  ♦ 

IPMP  1=  It 

^'Pl 

IF( IPMPl 

-MF  ) 

BLEQ    -     BAND    LINEAR    EQUATtflNS     SflLUTIflN    -    FflRTRAN     II     C< 


35C1 

00  35  J=IPMPl.MF 
B( I.J)=0.0 

35 

B(NEMIP1 ,J)=C.O 

35C2 

SMALL=1.0 
T=+l.O 
IXP  =  0 

40 

3 
2 

5 

00  30  1=1. NF 

BIG=B{ 1,1) 

F  =  BIG 

00  2  J=2.MF 

IF(BIG-B{ I.J))3.2.2 

BIG=B< I.J) 

F  =  BIG 

C0NTINUE 

tF(BIG)4.5.4 

PIVB=0.0 

DETB=0.0 

G0  Ta  33 

4 

ASSIGN  55  T0  NJ 
G0  T0  60 

55 

ASSIGN  31  T0  NI 
G0  T0  28 

31 

00  34  J=1,MF 

34 

B(  I.J)=B(  I  .J)/BtG 
00  30  J=1.KF 

30 

R<  I.J)=R(  I.J)/BIG 

39 

L0W  =M 

00  421=1. NF 

L0W  =  XNINOF(L0ia*l.NF) 

8IG=B( I. 1) 

KBIG=I 

IP1=I*1 

IF(I-NF)  36,9,36 

36 

00  6  K  =  IP1.L0I« 
IF(BIG-8(K . 1 ) )7.6.6 

7 

BIG::8(K.  1  ) 
KBIG=K 

6 

CaNTINUE 
IFtKBIG-I )e.9.e 

8 

T=-T 

00  10  J=l.MF 

BIG=B( I.J) 

B(  I.J)=B(K6IG. J) 

10 
I  1 

B(K8IG.J)=BIG 

00  11  J=1.KF 

BIG=R( I.J) 

R(  I.J)=R(KBIG. J) 

R(KBIG.J)=B1G 

9 

PIVB=B( I . 1 ) 

IF(*BSF(SMALL)-ABSF( 

[PIVB)  )37.37,3e 

38 

SMALL=PIVB 

37 

F=PIVB 

ASSIGN  32  T0  NI 

G0  T0  28 

32 

D0  12  J=2.MF 

BLEQOSeO 
BLE00570 
BLEQOSaO 
eLEQ0S90 
BLE00600 
BLEQ0610 
Bl.Ea0620 
BLE00630 
BLEQ0640 
BLE006SO 
BI.EO0660 
BLE00670 
BLEOOeaO 
BLEQ0690 
BLEQ0700 
8LEQ0710 
BLE00720 
BLEQ0730 
BLEQ0740 
BLE00750 
BLE00760 
BLEO0770 
BLEQ0780 
BLEQ0790 
BLEQ0800 
BLEQ0810 
BLEQ0e20 
BLEQ0a30 
BLEOOSAO 
BLEQOeSO 
BLEQ0a60 
BLEO0e70 

BLEOoaao 

BLEQ0890 
BLEQ0900 
BLEQ0910 
BLE00920 
BLEQ0930 
BLE0094C 
BLEQ09S0 
BLE00960 
BLEQ0970 
BLEQ09aO 
BLE00990 
BLEOIOOO 
BLEQIOIO 
8LEQ1020 
BLEQ1030 
BLEQ1040 
BLEQ1050 
BLEQ1060 
BLEQ1070 
BLE01080 
BLEQ1090 
BLEQllOO 
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BLEQ  -  BAND  LINEAR  EOUATIfNS  SSLUTItN  -  FIRTRAN  II  CflOEO 
e(  I. J)=B(  I  . J>/PIVB  BLEQIllO 


00  13  J=l.KF 
13      R( I. J)>R( I .J)/PIVB 
IF(  I-NBI  M.  IS.  IS 

14  00  42  K=IP1.L0I.  BLE0I150 
FACT=fl(K.l)  BLeQII60 
00     41     J=I.KF  BLEQH70 

41  R«K,  J)=R(K.J>-FACT«H|I.J)  BI.EOI180 
O0IJ  =  2.MF  BLEOH90 

I                  B(K.J-l)xB«K.J)-FACT»B(I.J)  BLEOIZOO 

42  B(K.MF)»0.0  BLEQI2I0 

15  lOHxl 
00     16    Kxl.NBMI 
NBMK'NF-K 

IGH=XMINOF( IGH«I .MF)  BLEOI2S0 

00     16    L=2.IGH  BLE0I260 

NBMKPL=NBMK*L-1  BI.EOI270 

00     16    J=1.KF  BLEOI2eO 

16  RiNBMK. J)=n(NeMK.JI-8(N8MK.L)«R(NeMKPL.J)  BLEQI290 
1602  N02»N0l-XAeSF( IKP)  0LEOI3OO 

N02xN01-XABSF(  IXP)  B(.E013IO 

63           IXP.IXPMV  BLE0I320 

IF(XA8SF(  I V)-N02)Sa.58.70  BLEQ I  330 

70            IF<XSIGNF( I. |XP)«XSIGNF« l,IY))Se.57.57  BLEQI340 

BSe           IF(EXP»377eO0OCO0OO)57,59,57  BLE01350 

857           EX=377     777     777     777  BLE0I360 

IXP.IALS  BLEQ1370 


BLE01I20 
BLE01130 
BLEOt 140 


8CE0I220 
BLEOI230 
BI.EOI240 


IDET=IT*IXP 

OETB=CET*e 

PIVe=SMALL 

MB=MHT 

RETURN  BLEOI420 

IF  «*BSF<F)7  1.0/2.0)  18,  19.19  BI.EOI430 

F«2.0«F 

IXP= IXP-NE0 

T*T«F 

tF(T  )2  1,20.21 

IXP  =  0 

G0  T0  22  BLEQI490 

IF { A8SF ( T )- 1.0/2.0)24.25.25  BCEOI500 

T=T«2.0 

IXP= 1XP-NE0 

G0  T0  21 


Bi.EQI380 

Bt.EQI390 

BLEOI400 

EOI4I0 


BI.EOI440 
BLE014S0 
B(.EQI460 
BL  EC  14  70 
B(.EOI4a0 


BLEQI5I0 
BLE0I520 
BLE01530 


iF(»BSF<  T  )-1.0>27.26.26  BLE01540 


T=T/2.0 
IXP= IXP»NE0 
G0     T0     26 

G0     T0    Nl. (31. 32. 49)  BLE01580 

F=(BIG«400777777777)«200     000     COO     COO  BLE01590 

EP=BIG«377     000     000     000  BLEQ1600 

IP=»(  IP-1C).I*HS  BLEQ16I0 

N02  =  N01-XAeSF(  lY)  BLEQI620 

«^='^»'*'  BUE0I630 

IF(XABSF( IP)-N02)6  1.61 .71  BLEQ 1640 

IF(XSIGNF{  1.  IY)»XSIGNF(I.IP)  ) 4  1.54. 54  BLEQ 1650 
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BLEOISSO 
BLE01560 
BLEQI570 


BLEQ  -  BAND  LINEAR  EOUAT10KS  S0LUTI0N  -  FBRTRAN  II  CflOED 

EX=377  777  777  777  BLEQ1660 

G0  T0  NJ.(S5.56)  BLEQ1670 

END  BLEQ1680 
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Matrix  Inversion 

1.  GJRV   Gauss-Jordan  Matrix  Inversion  -  FORTRAN  Coded 

2.  MINV   Matrix  Inversion  -  FORTRAN  Coded 

3.  SYMINV  Symmetric  Matrix  Inversion  -  FORTRAN  Coded 
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Identification:   GJRV  -  Matrix  Inversion,  Gauss-Jordan 
7090  -  FORTOAN  II  Coded 

Purpose:   This  Is  a  FORTOAN  II  subroutine  written  from 

the  Algol  program  gjr  by  H.  R.  Schwarz  published 
In  the  Comm.  of  the  ACM,  February  I962,    pp.  82-95 
"It  accomplishes  the  numerical  Inversion  of 
matrices  with  the  method  of  Gauss-Jordan  as 
proposed  by  H.  Rutlshauser,  Zur  Matrlzenlnverslon 
nach  Gauss-Jordan,  ZAMP  10  (1959),  pp.  28I-29I. 
The  program  uses  pivotal  search  and  exchange  of 
the  pivotal  row  and  column  with  the  k-th  row 
and  column.   Thus  In  the  k-th  Jordan  step  the 
k-th  diagonal  element  becomes  the  pivot.   This 
makes  the  determination  of  the  pivot  In  the 
remaining  matrix  simpler  but  makes  a  final 
reordering  of  the  matrix  necessary." 
See  also  Certification  of  gjr,  Comm.  of  the  ACM, 
Jan.  1963,  p.  40. 

Usage:     CALL  GJRV(A,N,EPSIL,IERR) 
where 
A         Is  the  matrix  to  be  Inverted. 

The  result  Is  stored  In  A. 
N         Is  the  order  of  the  matrix. 
EPSIL     Is  a  value  to  be  used  as  a  tolerance 
for  acceptance  of  the  singularity  of 
the  given  matrix. 
lERR      will  contain  a  zero  upon  normal  return 
or  a  -1  In  case  of  a  singular  matrix. 

Notes:  1)  The  original  matrix  A  Is  destroyed  In  all  cases. 
2)  100  X  100  locations  are  specified  for  matrix  A 
In  this  subroutine.   If  larger  or  smaller 
DIMENSIjZiN's  are  reserved  In  the  calling  program 
the  DIMENSION  statements  In  the  subroutine  must 
be  changed  to  agree  with  those  In  the  calling 


program.   In  addition,  there  are  four  other 
vectors  of  DIMENSION  100  which  appear  In  the 
subroutine  which  may  be  changed  at  the  same 
time  If  space  Is  at  a  premium. 
Time  and  Accuracy: 


To  Invert  tY. 

le  Gamma  matrix: 

^^3- 

-n^^^^^^'   ^^ 

J  , 

for  N  =  20 

Time:        l.l4  sec. 

N  =  40 

6.60  sec. 

N  =  6o 

20.40  sec. 

N  =  100 

1  mln.  31.20  sec. 

The  absolute 
along 
for    main 

i  maximum  error: 

;  the      along  the 

dlag.     side  dlag. 

along  the  out- 
side dlags. 

N=20  .49E-06(10,10)*.37E-06(10,9) 

.16E-06(10,5) 

N=40  .77E-06(27,27)  . 56E-06(26,27) 

.28E-06(7,14) 

N=6o  .llE-05(4o,4o)  .86e-o6(4o,39) 

.4lE-06(17,33) 

N=100  .22E-05(l6,l6)  .15E-05(l6,17) 

.89E-o6(29,13) 

The  absolute  maximum  error  In  the  rows: 

for  N  =  20  Is  the  10  row,  10  col.  and  =  .49E-06 

40       27     27  .77E-06 

60       40     40  .llE-05 

100       16      16  .22E-05 

The  numbers  In  parentheses  refer  to:   row,  column. 
Requirements: 

a)  System  Built-in  Functions  (open  subroutines) 
ABS 

b)  Storage 

BBl^Q  =  l^^^S  locations  including  400  storage 

locations  for  4  Vectors  each  of  size  100, 
Author:   Florence  P.  Ragusa 
Date:     April  I965 
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GJRV  -  GAUSS-J0RDAN  KATRIX  INVEHSIBN  -  FaRTHAN  II  CeOED 


GA(JSS-J0ROAN  INVERSI0N  0F  MATRICES  PRBPeSED  BY  H. RUT  I SHAUSER   GJRVOOIO 

IN  ALG0L.  ACM  JDURNALL  FEB.  1962.  F0HTRAN  BY  RAGUSA.              GJRV0020 

SUBR0tJTINE  GJHV(A.N,EPSIL,IERfi)  GJRV0030 

OIMENSI0N  A(IOO.IOO).  BliOO),  C(IOO).  IPIIOO).  10(100)              GJRV0040 

ieRR=0  GJRVOOSO 

00  140K=1,N  GJRV0060 

PIV0T=O.O  GJRV0070 

00  120  I=K.N  GJRVOOSO 


00  2  J=K.N 


C0NTINUE 


IF( IP(K)-K )4,e.4 


IPX=IP(K ) 
Z  =  A(  IPX, J) 
A( IPX, J)=AI 

5      A(K, J)= 

6 


GJRV0090 


IF(ABSF( A( I , J) )-AaSF(PI V«T) )  2,2.1                                       GJRVOIOO 

PIV0T=A(I,J)  GJRVOIIO 

IP(K)=I  GJRV0120 

IQ(K)=J  GJRV0130 

CBNTINLE  GJRVOI40 


GJRV0150 


IF( AeSF(PIV0T)-ePSIL)  100.  10  0,3  GJRV0160 


GJRV0170 


00  5  J=1,N  6JRV0180 


GJRV0190 
GJRV0200 
GJRV0210 
GJRV0220 
IF( IO(K)-K >7,9.7  GJRV0230 

7  00  e  I=1,N 
IPX=IQ(K ) 
Z=A( I, IPX) 
A( 1 . IPX)=A( I.K ) 

8  A( I ,K)=Z 

9  00  13  J=1.N 
IF( J-K  )  1 1 .  10.  1  1 

10  8(J)  =  I.O/PIV0T  ^■'"^°^*° 
C{ J)=1.0 
G0  T0  12 

11  B( J)=-A(K. J)/PIV0T 
C( J)=A( J,K ) 

12  A(K, J )=0.0 
A( J,K)=0.0 

13  C0NTINUE 
00   14   1=1, N 
00   14  J=1.N 

14  A(  I  , J  )=A(  I  . J)+C(  I  )«8( J) 
14C       C0NTINL.E 

00  20  KP=1 ,N 
K=N* 1-KP 

IF( IP(K )-K)   15. 17.15 

15  00  16  1=1. N 
IPX=IP(K ) 
Z=A( I, IPX) 
A(  I,  IPX)=A(  I  ,K  ) 

16  A( I ,K)=Z 

17  IF{  IQ(K)-K  )  18,20, 18 

18  00  19  J=I,N 
IPX=IQ(K  ) 
Z=A( IPX, J) 


GJRV0240 
GJRV0250 
GJRV0260 
GJRV0270 
GJRV02eO 
GJRV0290 
GJRV0300 


GJRV0320 
GJRV0330 
GJRV0340 
GJRV0350 
GJRV0360 
GJRW0370 
GJRV0380 
GJRV0390 
GJRV0400 
GJRV0410 
GJRV0420 
GJRV0430 
GJRV0440 
GJRV0450 
GJRV0460 
GJRV0470 
GJRV04eO 
GJRV0490 
GJRV0500 
GJRV0510 
GJRV0520 
GJRV0530 
GJRV0540 


-  168 


GAUSS-JBROAN  MATRIX  IKVERSISK  -  FBRTRAN  II  CBOEO 


*(  IPX.J)=A 

19 

A(K.J)=Z 

20 

C0NTINUE 

G0  T0  21 

IOC 

ieHR=-l 

21 

RETLRN 

ENO 

6JRV0550 
6JRV0560 
GJRV0S7O 
GJRVOSeO 
GJRVOS90 
6JRV0600 
GJRV0610 
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Identification:  niNV   -   Matrix  Inversion  , 

7090  -  FORTRAN  II  CodecJ 
Purpose:   This  is  a  FORTRAN  II  subroutine  written  from 
Algorithm  120  by  Richard  George  published  in 
the  Comm.  of  the  ACM,  August  I962,  p.  437. 
"It  accomplishes  Inversion  of  the  matrix  A, 
with  the  result  stored  in  A.   The  order  of 
the  matrix  is  N.   If  in  the  process  of 
calculating,  any  pivot  element  has  an 
absolute  value  less  than  EPSIL,  a  parameter 
lERR  will  be  set  =  -1  and  there  will  be  a 
return  to  the  calling  program.   The  variable 
DELTA  will  contain  the  value  of  the  determinant 
of  the  original  matrix  on  normal  return  or  zero 
or  a  very  small  number  on  return  from  EPSIL  test 
mentioned  above." 

See  also  Certification  of  Algorithm  120, 
Comm.  of  the  ACM,  Jan.  I963,  p .  40 . 
Usage:     CALL  MINV(N, A, EPSIL, lERR, DELTA) 
where 

N         is  the  order  of  the  matrix  A 
A         is  the  matrix  to  be  Inverted. 

The  result  is  stored  over  A. 
EPSIL     is  a  value  to  be  used  to  test  the 

pivot  elements .   If  any  pivot  element 
has  an  absolute  value  less  than  EPSIL 
the  subroutine  will  cease  operating, 
will  set  lERR  =  -1  and  will  return  to 
the  calling  program. 
lERR      is  a  variable  which  will  contain  a 
zero  upon  return  if  inversion  is 
completed  or  a  -1  otherwise. 
DELTA     will  contain  the  value  of  the 

determinant  upon  return  if  inversion 
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is  completed.   Otherwise,  when  lERR  =  -1, 

DELTA  will  be  equal  to  0.0  or  a  very  small  number, 

Notes:  1)  The  original  matrix  A  is  destroyed  in  all  cases. 
2)  100  X   100  locations  are  specified  for  matrix  A 
in  this  subroutine.   If  larger  or  smaller 
DIMENSI0N's  are  reserved  in  the  calling  program 
the  DIMENSI0N  statements  in  the  subroutine  must 
be  changed  to  agree  with  those  in  the  calling 
program.   In  addition,  there  are  three  other 
vectors  of  DIMENSI0N  100  which  appear  in  the 
subroutine  which  may  be  changed  at  the  same 
time  if  space  is  at  a  premium. 

Time  and  Accuracy: 

To  invert  the  Gamma  matrix: 

^  1   J    ' 

for  N  =  20   Time:  .6  sec. 

sec . 

sec . 

sec . 

The  absolute  maximum  error: 

„     along  the     along  the     along  the  out- 
main  diag.    side  diag.     side  diags . 

N=20  .52E-06(9,9)''-50E-06(10,9)  .19E-06(8, 15) 

N=40  .12E-05(29,29).llE-05(25,26)  .6:5E-06(21, 11) 

N=60  .32E-05(33,33).27E-05(28,29)  .10E-05(37,l8) 

N=100  .58e-05(44,44).66e-05(76,77)  .30E-05(54,27) 

The  absolute  maximum  error  in  the  rows: 

for  N  =  20  is  the   9  row,  9  col.  and  is  .52E-O6 

40        29     29  .12E-05 

60       33     33  .32E-O5 

100        49     44  .72E-O5 

The  numbers  in  parentheses  refer  to:  row,  column, 


*1J 

-  *ji 

= 

i(r>fl-j) 
n+1 

:       20 

Time: 

.6 

40 

4.2 

60 

13.8 

100 

1 

min.      7-2 
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Requirements: 

a)  System  Built-in  Functions  (open  subroutines) 
ABS 

b)  Storage 

806-,Q  =  l446o  locations  including  3OO  storage 
locations  for  3  vectors  each  of  size 
100. 

Author:   Florence  F.  Ragusa 

Date:   April  I963 
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MATRIX  INVERSIIN  -  FflRTRAN  II  C0OEO 


CMINV   MATRIX  INVEBSIBN  FRBM  ALG0RITHM  120.  ACM  AUGUST  t 962 .F .R AGUS A      MINVOOIO 

sueneuTiNE  minv(n. a.epsil  .ierr.oelta)  minvoo20 

C  MINW0030 

C       N  IS  0ROER  0F  MATRIX  A.  MINV0040 

C       A  IS  A  MATRIX  NXN  0RCER  MINV0050 

C       EPSIL  IS  A  VALUE  BEL0W  WHICH  ANY  PIV0TAL  ELE»»ENT  MAY  NBT  G0  (ABS.  MINV0060 

C       VALUE)   lERR  HILL  BE=-I   IF  PIVBT  ELEM.  F0UKD  T0  HAVE  ABS.  VALUE  MINV0070 

C       LESS  THAN  EPSIL.  MINV0080 

C       lERR  WILL  BE  =0  0THER\»ISE.  MINV0090 

C       DELTA  WILL  C0NTAIN  VALUE  0F  OETEHKINANT  0F  0RIGINAL  ELEMENT  0R  MINVOIOO 

C       DELTA  1»ILL=0.0  IF  IERR=-1.(SEE  lEHH)     0R  A  VERY  SMALL  NUMBER.      MINVOIIO 

C  MINV0120 

C  NeTE..MAKE  DIM.  F0R  A.B.C.IZ  HERE  EQUAL  T0  THAT  0F  CALLING  PR0GRAM.     MINV0130 

C  MINV0140 

DIMENSI0N  A(IOO.IOO).  8(100).  CCIOO).  12(100)                           MINVOISO 

DELTA=1.0  MINV0160 

IERR=0  MINV0I70 

D0  99  J=1.N  MINVOieO 

99     IZ(J)=J  MINV0I90 

C  MINV0200 

D0  100  1=1. N  MINV0210 

K=I  MINV0220 

Y=A( I.I)  MINV0230 

L=I-1  MINV0240 

IP=I+1  MINV02SO 

C         IF  IP  GREATER  THAN  N  SKIP  THE  2  Le0P                                      MINV0260 

IF(IP-N)  98.98.3  MINV0270 

C  MINV02eO 

98     D0  2  J=IF.N  MINV0290 

*=A( I.J)  MINV0300 

IF(ABSF(V»)-AeSF(Y))2.2.1  MINV0310 

1  K=J  MINV0320 
Y=W  MINV0330 

2  C0NTINUE  MINVO3A0 
C  MINV0350 

3  OeLTA=DELTA»Y  MINV0360 
IF( ABSFC  Y)-EPS  IL)200,4.4  MINV0370 

4  Y=1.0/Y  MINV03e0 
C  MINV0390 

MINV0400 
MINV0410 
MINV0420 
MINV0430 
MINV0440 
MINV0450 
MINV0460 
MINV0470 
MINV0480 
MINV0490 
MINV0500 
MINV0510 
0  K=1.L   AND  P.N  F0R   J=I.L   AND  P.N  MINV0520 

MINV0530 
MINV0540 


D0  5  J=1.N 

C( J)=A( J.K  ) 

A{  J.K)=A(  J.I  ) 

A(  J.  I  )=-C(  J)»Y 

A( I . J )=A( I . J )»Y 

5 

B( J)=A( I.J) 

C 

A(  I  ,  I  )  =Y 
J=  12  (  I  ) 
IZ(  I  )  =  IZ(K  ) 
IZ(K )=J 

C 

c 

FP0M  HERE 

IF(L)  6C.eo,e 

T0  160 

60 

iF( iP-N)  ei.ei , 

.ICO 
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MINV  -  MATRIX  INVERSIBN  -  FBRTRAN  II  CBOEO 

61  D0  63   KxIP.N  MINV0550 
00  62   J=IP.N  MINV0560 

62  A(K.J)  =A(K. J)-B( J)»C(K)  M1NV0570 

63  C0NTINUE  MINVOSeO 
G0  T0  100  MINV0590 

6      00  11   K=1.U  MINV0600 

00  8    J=1.L  MINV0610 

8  A(K.J)  =A(K,J)-B( J)»C(K)  MINV0620 
IF  (IP-N)  q.9.11  MINV0630 

9  00  10   J=IP.N  MINV0640 

10  A(K.J)  =A(K. J)-B( J)»C(K)  MINV0650 

11  C0NTINUE  MINV0660 
IF  (IP-N)    120.120.100  MINV0670 

120     00  160   K=IP.N  MINV0680 

00  140  J=1.L  MINV0690 

14C    A(K.J)  =A(K. J)-B< J)»C(K)  MINV0700 

00  150    J=IP.N  MINV0710 

150   A(K.J)  =A(K.J)-B(J)»C(K)  MINV0720 

16C   C0NTINUE  MINV0730 

IOC   C0NTINUE  MINW0740 

MINV0750 

12  00  16  1=1. N  MINV0760 

MINV0770 
MINV07eO 


K=I2(  I  ) 

IF<K-I  )  14.  16.  14 

00  15  J=1.N  M1NV0790 

MINVOeOO 


l=A( I.J) 


WI.J)=A(K.J)  MINV081 


A(K.  J)=»l 
C0NT INUE 

IP=1Z( I ) 
IZ(  I  )=IZ(I 
IZ(K  )  =  IP 


G0 


END 


MINV0a20 
MINV0e30 
MINWOa40 

MiNvoeso 

MINV0860 
MINVOe70 


DELTA=-DELTA  MINVOBBO 

MINV0890 
MINV0900 


16     C0NTINUE  MINV0910 

G0  T0  201  MINV0920 

MINV0930 
'20c    IERR=-1  MINV0940 

201    RETURN  MINV0950 


MNV0960 
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Identification:   SYMINV  -  Symmetric  Matrix  Inverse  Subroutine 

FORTRAN  II  Coded-  7O9O 
Purpose;   This  routine  computes  the  Inverse  of  a  symmetric 
matrix.   See  Algorithm  I50,  Comm.  of  the  ACM, 
V .  6 ,    no .  2 
Usage:    The  calling  sequence  Is 

CALL  SYMINV(A,P,Q,R,N,IFAIL) 
where: 
A         Is  the  name  of  an  array  to  be 

inverted 
N         is  the  order  of  A 

IPAIL     =  0  if  the  subroutine  has  executed 
correctly 
=  1  if  not 
P,Q,R     are  three  1-dlmenslonal  arrays  to 
be  used  for  working  storage. 
They  should  be  of  dimension  N. 
Note:      Only  the  upper  right  section  of  A(I,J)  is 
used  by  SYMINV  i.e.,  only  A(I,J),  I  >  J, 
is  used.   The  Inverse  is  stored  on  top 
of  these  elements,  i.e.  only  the  upper  right 
section  of  A~   is  computed. 
The  routine  uses  3N  locations  of  working 
storage  P,Q,,R  and  has  been  written  for  N  <  100, 
Requirements : 

a)  System  Built-in  Functions  (open  subroutines) 
ABS 

b)  Storage 

322nQ  =  502o  locations 
Author:   J,  R.  Swenson 
Date:     April  I963 
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00  10  I  - 
R(  I  ) 


INV  -  SVyVETRIC  KATRIX  INVEBSie^  -  FBBTRAN  II  CBOEO 


CSYMINV     ALG0HITHf   150.  SYMMETRIC  MATRIX  INVERSE  SYMIOOlO 

C       RUT  ISHAUSER.  C0MM.  A. CM,  VBL  6.  NB.  2  SYMI0020 

C  THIS  PR0GRAM  0BTAINS  THE   INVERSE  BF  A  SYMMETRIC  MATRIX  flF       SYMI0030 

C       0RDER  N.  THE   IFAIL  PARAMETER  =  1   IFF  N0  INVERSE  CAN  BE  FBUNO.  THE  SYMI0040 

C       0RIGINAL  MATRIX  IS  DESTR0YEO.  SYMI0050 

SUBRaUTINE  SYMINV   ( A , P . Q . R , N .  I  F A  I L)  SYMI0060 

OIMENSI0N  A( 100. 100) .P( 100),C(100).R< 100)  SYMI0070 

IFAIL  =  C  SYMI0080 

B  TRLE  =  377777777777  SYMICOgO 

B  FALSE  =  COCOOOOOOOOO  SYMIOIOO 

C  CeNSTRUCT  TRLTH  TABLE  SYMIOllO 

SYMI0120 

SVMI0130 

BEGIN  PRBGRAM  SYMI0140 

SYMI0150 
SEARCH  FBR  PIVBT  SYMI0160 

SYMI0170 
SYMI0180 
SYMI0190 
SYMI0200 
SYMI0210 
SYMI0220 
SYMI0230 
SYMI0240 
FREPARATIBN  FBR  ELIMINATION  STEP  I     SYMI0250 

SYMI0260 
SYMI0270 
SYMI02eO 
SYMI0290 
SYMI0300 
SYMI0310 
SYMI0320 
SYMI0330 
SYMI0340 
SYMI0350 
SYMI0360 
SYM10370 
SYMI03eO 
SYMI0390 
SYMIOAOO 
SYMI0410 
SYMI0420 
SYMI0430 
SYMI0440 
SYM10450 
ELIMINATIBN  PRBPER  SYMI0460 


BIG  =  C. 

Da 

39  J  =   l.N 
TEST  =  ABSF(A( J.J) ) 
IFITEST  -  BIG)  39.39.31 

2  1 

IF(R ( J  )  )   ICC .39. 32 

32 

BIG  =  TEST 
K  =  J 

29 

C0 

NTINUE 

R{K)  =  FALSE 
Q(K)   =   l./A(K.K) 
P(K)   =   1. 
A(K.K )   =  0 . 
KPl  =  K  ♦   1 
KMl  =  K  -   I 
IF(KM1 )   100.50.40 

40 

Da 

49  J  =  l.KMl 
P( J )  =  A<  J .K) 
0(J)  =  A(J,K)  •  C(K) 
IF(R(J))   100,49.41 

4  1 

Q( J)  =  -Q( J) 

49 

A( J.K)  =  0. 

50  IF (K  -  N )  51 .60, IOC 

51  DU  59  J  =  KPl.N 

P( J)  =  A(K.J> 
IF(H( J  )  )   100.52.53 

52  P( J )  =  -P( J) 

53  0( J)  =  -A(K. J )  • 
59       A(K.J)  =  0. 


eO  00  20  J  =   l.N 
00  20  K  =  J,N 
20       A(J,K)  =  A(J.K)  ♦  P(J)«G(K) 

FAILLRE  RETURN  SYMIC510 


ICO        IFAIL  = 
RETLRN 
END 


SYMI0470 
SYMI0480 
SYMI0490 
SYMI0500 


II0520 
SYMI0530 
SYMI0540 
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Eigenvalues  and  Eigenvectors 


1.  MLEWl   Eigenvalues/Vectors  of  Real  Symmetric 

Matrices  -  PAP  Coded 

2.  MLEW2   Eigenvalues/Vectors  of  Real  Symmetric 

Matrices  -  FORTRAN  Coded 

Eigenvalues  of  Real  Matrices  -  FORTRAN 
Coded 

Eigenvalues  of  Complex  Matrices  - 
FORTRAN  Coded 

Eigenvalues/Vectors  of  a  Real  Symmetric 
Matrix  -  FORTRAN  Coded 

Eigenvalues/Vectors  of  a  Real  Sinmnetric 
Matrix  -  FORTRAN  Coded 

LRCH    Eigenvalues  of  a  Real  Symmetric  Matrix  ■ 
FORTRAN  Coded 


3- 

EIG5 

k. 

EIG4 

5- 

H0US1 

6. 

H0US2 

-  177 


Identification:   MLEWl  -  Eigenvalue-Eigenvector  Routine 
Real  Symmetric  Matrices 
FAP  Coded  -  709O 
Purpose:   Computes  all  the  eigenvalues  and  vectors  of  a 

real  symmetric  matrix. 
Method :    Householder's  method  Is  used  to  reduce  the  matrix 
to  trldlagonal  form.   The  eigenvalues  are  then 
Isolated  using  Sturm  sequencing  and  finally  the 
vectors  are  found  by  Wilkinson's  method.   See 
the  Appendix  of  this  write-up  for  further 
details  . 
Usage:     The  program  Is  coded  as  a  subroutine  conforming 
to  FORTRAN  standards,  and  so  can  be  used  with 
either  FORTRAN  or  FAP  using  the  CALL  statement 
appropriately.   The  usage  Is  given  explicitly 
for  FORTRAN. 

CALL  MLE¥(M,A,EIG,V,IR0W)    If  the  eigenvectors 

are  to  be  stored  In 
core  location  V. 
CALL  MLEWT(M,A,EIG,IT,IR0W)  If  the  eigenvectors 

are  to  be  stored  on 
binary  tape  IT. 
M         Is  the  order  of  the  matrix  to  be  solved. 

M  >  1 
A         Is  the  matrix  to  be  solved. 

Two-dimensional  floating  point  array. 
EIG       Is  a  floating  point  two-dimensional 

array  which  is  to  contain  the  eigenvalues 
in  its  first  column,  and  four  more 
columns  which  are  used  by  MLEW  for 
temporary  storage.   It  should  be  given 
the  dimension  (IR0W,5) 
V         is  a  floating  point  square  array.   The 
eigenvectors  will  be  stored  in  its 


178 


columns.   V  is  not  used  if  MLEWT 

is  called. 
IT     is  the  logical  tape  number  of  the  binary 
■  tape  on  which  the  eigenvectors  are  to 

be  written.   IT  Is  not  used  if  MLEW  is 

called . 
IR0W   is  the  number  of  rows,  as  it  appears 

in  the  DIMENSI0N  statement,  for  A,  EIG, 

and,  if  used,  V.   IR0W  >  M. 
Output:    The  eigenvalues  EIG(I,1),  (I  =  1,M)  will  appear 
in  the  first  column  of  EIG  in  decreasing 
algebraic  order. 

The  eigenvector  corresponding  to  the  largest 
(algebraic)  eigenvalue  is  computed  first,  the 
vector  associated  with  the  next  largest 
eigenvalue  second,  and  so  on.   When  MLEW  is 
called,  the  eigenvectors  will  be  stored  by 
columns  (with  M  elements  per  column)  in  V, 
When  MLEWT  is  called,  the  eigenvectors  will 
be  written  on  tape  IT  in  M  logical  records 
of  M  words  each.   Each  eigenvector  is  normalized 
to  unity.   Duplicate  eigenvalues  have  identical 
eigenvectors  assigned  to  them.   The  tridiagonal 
matrix  is  still  present  at  the  end  of  the  compu- 
tation.  The  diagonal  is  the  final  diagonal  of 
A,  and  the  off  diagonal  occupies  the  first  M-1 
rows  of  the  fifth  column  of  EIG. 

Q 

TJjne:      For  M  >  20,  time  is  roughly  .072(M-10)  +  8  sec. 

(for  the  7090) . 
Requirements: 

a)  System  Library  Functions  (closed  subroutines) 

SORT 
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The  routine  also  uses  the  subroutines  necessary 
to  write  a  binary  tape.   These  routines  are 
discussed  more  fully  in  the  final  section  of 
this  report, 
b)  Storage 

854-j^Q  =  I526g  locations  plus  absolute  locations 
775760-77675Q  f'or  temporary  storage. 
Author:    Sam  Greenspan  and  Aubey  Rotenberg 
Date:      September  I962,  Revised  November  I963. 
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Appendix  on  Method  and  References 

The  real  symmetric  m  x  m  matrix  A  Is  reduced 
to  trldlagonal  form  by  a  method  suggested  by  Householder 
In  [1] .   The  reduction  occurs  In  m-2  steps: 


a(«  = 

P   A^^-l^  P 
^k  ^      ^k 

k  =  2,  .  .  .,1 

^k  = 

1-20.^0^1 

where  A^"^^  =  A,  and  o^^   Is  a 

zero  components,  and  03,03,  = 

(]<:   1) 
from  A^    ',  that  If  we  write 

real  vector  with  k-1  leadlnj 
1.   03,  Is  so  determined 
a"^'  :  ia[f),   «e  have 

=  0        j  =  k+1 , . . . ,m. 

It  follows  that 

0 

4  =^ 

k  =  2, . . .,m-l. 

,m-l 


f  k) 

and  that  A^  '  Is  real  symmetric  for  each  k,  and  that 

A^   and  A^  ~  ■^  are  the  same  except  perhaps  for  the 
Intersection  of  the  last  m-k+2  rows  and  columns. 
Complete  details  of  the  method  are  given  In  [2],  and 
an  error  analysis  In  [3]. 

Having  obtained  the  trldlagonal  form,  the 
number  of  eigenvalues  of  A^'^"    (=  the  eigenvalues  of  A) 
which  equal  or  exceed  a  given  number  A  Is  found  using  the 
fact  that  A^"^'^^  -  AI  is  the  direct  sum  of  regularly 
arranged  matrices,  where  by  "regularly  arranged"  we  mean 
that  the  sequence  of  leading  principal  minor  determinants 
is  a  Sturm  sequence.   By  varying  A,  all  the  eigenvalues  are 
^"■•^■^.   See  [4]  and  [5].   The  procedure  requires  a  column 

estimates  of  each  eigenvalue,  and  temporarily 
aiiothei'  column  of  lower  estimates.   Sturm  sequencing 
continues  until,  for  every  eigenvalue,  the  computed  mean 
of  its  two  estimates  is  one  of  the  two  estimates. 
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If  A  Is  the  final  estimate  of  an  eigenvalue, 
then  a  corresponding  vector  of  a^"^"^^  Is  found  by  first 
triangularlzing  A^^"    -  AI  using  Wilkinson's  method  [6]. 
Starting  with  three  diagonals,  the  forward  process  is 
executed,  and  the  final  triangle  stored  in  just  three 
columns  of  temporary  working  storage.   If  a  diagonal  zero 
occurs  at  all  in  the  final  triangle,  the  process  is  such 
that  it  must  occur  in  the  last  diagonal  space.   However, 
it  is  possible  that  not  even  a  small  diagonal  element 
occurs  (cf.  [6]).   To  lessen  the  chance  of  overflow  or 
underflow,  the  back  process  starts  with  right  hand 
column  elements  equal  to  the  last  diagonal  element  in 
the  triangle  instead  of  unity  as  suggested  by  Wilkinson. 
The  last  component  of  the  eigenvector  is  set  to  1 
without  a  division.   Duplicate  eigenvalues  are  assigned 
the  same  eigenvectors. 

The  eigenvectors  of  A^"^~   are  turned  into 
the  eigenvectors  of  A  by  applying  to  them  the  reflections 
P,  ,  k  =  2, . . • ,m-l,  in  reverse  order  k  =  m-1,  ... ,2.   All 
the  information  necessary  in  order  to  specify  the  P^  is 
accommodated  in  the  upper  triangle  of  the  original  matrix. 
In  consequence,  the  off  diagonal  of  A^"^~    is  displaced 
and  requires  an  extra  column  of  storage  (cf,  [2]). 
References 
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TSX 

PZE 

LCQ 

FMP 

FHN 

bTk) 

LXD 

TXI 

16A2 

TXL 

16A4 

LXC 

DI3  It  LLL=LPl  .N 

A(L,LLL)=C»A(L,LLL) 

LPl  .4 

LLL,4  CAN  ARRIVE  HERE  FRgK"  161 

DDWAY.4 

L . 1 ,LLL 


lOeCREMENT  SET  II 
VRRIVE  HERE  FR0M 


1641,4  ^ 

L.4  CAN 
TXI  •+1.4,1 
TXL       4A1.4  NM2, DECREMENT  SET  IN3A1 

EXTRA(N-1.4)=A(N-1,N) 
LXC       N.4  CAN  ARRIVE  HERE  FR0M  3A2 
TCJX       AXT1,4,1 
SXC        NM I  ,4 
TSX       BD»iA¥,4 
PZE 
TSX 
PZE 
CLA< 
ST0< 

TRIDI AG0NALIZATI0N  HAS  BEEN  C0MPLETEC. 
THE  NEW  DIAG0NAL  0CCUPIES  THE  DIAGBNAL  IN  A. 
THE  0FF  DIAGONAL  0CCUPIES  EXTBA(..4). 
EACH  RSI*  HF  THE  UPPER  TRIANGLE  0F  A  C0NTAINS 
INF0RMATI0N  AI10LT  0NE  0F  THE  N-1   0RTHeGeNAL 
SIMILARITY  THANSF0RMATI 0NS  LSED. 
THE  L0WER  TRIANGLE  0F  A  HAS  N0T  YET  BEEN  TBUCHEC, 

B0LND=ABSF(A(l,l))+AESF(EXTRA(1.4)) 

C0  18  I  4  =  2. N 

AR0LND  =  A8SF(A(I4,I4))+AB£F(EXTRA(I4,4))  +  ABSF(EXTF;A(I. 
18         80LND=MAX IF (BBUNO.AEeLNO ) 

EXTRA ( N,4 ) =0. 
TSX       BCwAY.4 


N^'l  ,2.FauR 
BDWAY.4 
NMl , 1 ,N 
A  ) 
EXTRA) 


MLEW0275 
MLEW027e 
MLEW0277 
MLE«»027e 
MLEW02  79 
MLEIi028C 
MLE*0281 
MLei»0282 
MLEli(02e3 
MLEK(02a4 
MLEW028S 
MLEl»028t 
MLE\ir0287 

MLEwoaee 

MLEX0289 
MLEX0290 
MLEli(02'31 
MLEW0292 
MLEK0293 
MLEW029  4 
MLew029S 
MLEO0296 
MLEW0297 
MLEW0298 
MLEW0299 
ML E WO  3 00 
MLEW0301 
MLEW0302 
MLEW03  0  3 
MLEW0304 
MLEW0305 
MLEW030e 
MLEW0307 
MLEW030e 
MLEW0309 
MLEW0310 
HLEM03  1 1 
MLEVI0312 
MLEX0313 
MLEW0314 
MLEW0315 
MLE»03ie 
MLew0317 
MLEw03ie 
MLEW0319 
MLEW0320 
MLEW0321 
MLtw0322 
MLEW0323 
MLEW0324 
MLFW0325 
»MLew032e 
MLFW0327 
MLEw032e 
MLEW0329 
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MLEW0330 
MLEW0331 
MLei#0332 
MLEIi(0333 
MLEW033A 
MLEW0335 
MLEW033e 
MLEW0337 
MLew0338 
MLEW033S 
MLEli(0  34C 
18A2  MLEW0341 

MLEII(0342 
MLElii(0343 
MLEW034A 
MLE«(034e 
MLEW034e 
MLEW0347 
MUEte0348 
MLEW0349 
MLEW0350 
MLEW0351 
MLEW0352 
MLEW0353 
MLEM0354 
MLEW0355 
2A9  MLEW035e 

MLEW0357 
MLEW0358 
MLEW03S9 
MLEW0360 
19A2  MLEW03ei 

MLEM0362 
MLEW0363 
MLEW0364 
MLEW0365 
MLEM0366 
MLEW0367 
MLE»l036e 
MLEM0369 
MLEW0370 
MLEW0371 
2A1C  MLEW0372 

MLEW0373 
MLEW0374 
MLEW0375 
ei*     24A16  MLEW037e 

MLEW0377 

MLE»K037e 

MLEW0379 

,l))/Z.  MLEW03aO 

21.2102  MLEM0381 

.21  .2103  MLEW0382 

MLEW0383 
MLEw03e4 


PZE 

N .2.F0UR 

STZ* 

EXTRA) 

18A 

TSX 

BDWAY.4 

PZE 

0NE . 1 ,0NE 

TSX 

0DWAY.4 

PZE 

0NE.2.F0UR 

CLA» 

A) 

S3P 

FAM» 

EXTRA) 

STB 

e0UND 

AXT 

2  .4 

18A1 

SXC 

14.4  CAN  ARRIVE  HERE  FR0l» 

TSX 

BDV»AY,4 

PZE 

14.  1  .  I  4 

TSX 

B0WAY.4 

PZE 

I4.2.F0LH 

CLA» 

EXTRA) 

SSP 

TXI 

•♦1.2,-1 

FAM* 

EXTRA) 

RAM* 

A) 

CAS 

B0UND 

ST0 

aeuNo 

N«P 

LXC 

14.4 

TXI 

•♦1.4.1                   * 

10A2 

TXL 

18A1,4  N. DECREMENT  SET  IN 
Did   19  J4  =  l  .N 
EXTRA! J4, 1 )=-B0UNO 

■ 

19 

EXTRA! J4.2)=B0UND 

19A 

AXT 

1  .4 

1941 

SXC 

J4.4  CAN  ARRIVE  HERE  FR0N 

TSX 

RC*AY.4 

PZE 

J4,2.0NE 

CLS 

B0UND 

ST0« 

EXTRA) 

TSX 

BCWAY.4 

PZE 

J4.2,TW0 

CUA 

B0UND 

sre* 

EXTRA) 

LXD 

J4.4 

TXI 

•♦1.4.1 

19A2 

TXL 

19A1.4  N. DECREMENT  SET  IN 
ILFA=0 

« 

20 

1LFA=ILFA+1 

2CA 

STZ 

lUFA 

20AI 

LXO 

ILEA. 4  CAN  ARRIVE  HERE  FR 

TXI 

•♦1.4.1 

SXC 

ILFA.4 

00  21  K2=1,N 

GMUs (EXTRA (K2, 2) ♦EXTRA (K2 

2101 

IF (EXTRA(K2.2  )-G^L)   2101. 

21C2 

IF   (GMU-EXTRA(K2. 1 ) )  2102 

21 

C0NT INUE 
G0  T0  25 
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21  A 

21  Al 


21  AJ 
?1  A7 


21  «4 
21  Ab 


SXD 
TSX 
PZE 
CLA« 
STfl 
TSX 
PZE 
CLA« 
STB 
FAC 
FRN 
FDh 
STO 
CLA 
FSB 

Tie 

CLA 

Fse 

TZE 
TPL 
LXC 
TX  I 


ARRIVE  HERE  FRBN  2IA< 


K2,4  Ct 

HDKAY.A 

K2,2.Twa 

EXTRA ) 

SLPLAM 

GCWAY.4 

K2,2,(1NE 

EXTRA ) 

bUBLAM 

StPLAM 

=H202400000000 

GMU 

SLPLAM 

GH'U 

21A7  TRANSFER  IF  K2  EIGEKVALLE  CMMPLTATIBN  FINISHED 

GMU 

SLRLAM 


TXL 

21A1 

IRA 

25A 

laFC 

F0FI 

ST2 

10FG 

CLA 

=  020 

STB 

F0FI 

00  2 

DLM  = 

DLMC 

2301 

IF(  I 

2302 

IF(D 

2303 

F0FI 

G0  T 

2304 

IF(  I 

2305 

IF(e 

2306 

F0F  I 

G0  T 

2307 

FBFI 

EQUI 

TE  =  2 

TF=F 

TG  =  F 

IF   ( 

2313 

I  TG  = 

FPIFI 

F0F  I 

F0F  I 

230e 

IF   { 

23Cq 

IF   ( 

TRANSFER  IF  K2  EIGENVALLE  CeCFUTATIBN  FINISHED 
TRANSFER  T0  FURTHER  CBKPLTE  K2  EIGENVALUE 

CAN  ARRIVE  HERE  FRe»i  21A2  BR  21Ae 
4.  1 

.4  N. DECREMENT  SET  IN  2A11 

TRANSFER  IF  ALL  EIGENVALLES  ENTIRELY  CaMPUTEC 
MU  =  0 
Ml  =  l. 

MU  CNA  ARRIVE  HERE  REEN  21A3 
1400000000 
Ml 

3  tR2=l.N 
EXTRA( IR2-1 ,4 ) 
ljM  =  A(  IR2.  IR2  ) 
R2-1  )2301  .2303.2302 
LM)2304 .2303.2304 

=  (OLMDtM-GML)•SIGNFI*NE.FeFI^'l  ) 
0  2308 

R2-2  )2304. 2306, 2305 
XTHA(IR2-2.4))23C7.23C6.2  30  7 

=(0LMDLM-GML)»FeFlMl-SIGNF(DUM»«2.FaF IM2) 
0  2308 

=(OLMOLM-GMU)«FaFIMl-CUM«»2»F0FIM2 
VALENCE   (TF.ITE).(TF.ITF).(TG.ITG) 

ooccooooooo 

0FI»377COOOOCOOO 

0FIM1»377OOOOCOOCO 

XABSF(ITF-ITC)-ITE)  23  08.2313.2313 

I TG*1 TE-I TF 

=(F0F I •400777777777 )»Te 

Ml =(F0FIM 1*4007777777 77 )»TG 

=F0F 1*0. 

F0F1)  2309.2310.2309 

SIGNFlFaFI.FPFIcn-FPFI  )     2312.2311.2312 
=  SIGNF(F0FI  .FaFIM  ) 


MLEW03aS 
MLE«036e 
MLEWOSe? 

MLEi»03ee 

MLE«l03e9 
MLEW0390 
MLEW0391 
MLEW0392 
MLEW0393 
MLEW0394 
MLE«039S 
MLEW0396 
MLEW0397 
MLEII0398 
MLEM0399 
MLEW0400 
MLEW0401 
MLe«(0402 
MLEH0403 
MLEl)0404 
MLEW0405 
MLEM0406 
MLEW0407 
MLE«[(040e 
MLEk0409 
MLEII04  10 
MLEW04 1 1 
ML  6*04 12 
MLEIK0413 
MLEW0414 
MLEX04  15 
MLEW0416 
MLEW0417 
MLEM04 18 
MLFa04  19 
MLew0420 
MLEW0421 
MLEM0422 
MLE«0423 
MLEW0424 
MLEW0425 
MLEW0426 
MLei»0427 
MLEW042e 
MLEW0429 
MLE(»0430 
MLEX0431 
MLEW0432 
MLEW0433 
MLE«04  3  4 
MLF«0435 
MLFX0436 
MLE<k0437 
MLE>»043e 
MLEW0439 
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t                     2311  t0FGMU=iaFGWU*l  MLEWOA40 

I         2312  F0FIM2=F0FIMl  MLEH0441 

t                     23  FaFIMl=F0FI  MLEH0442 

23A     AXT  1.4  MLEW0443 

23A1    SXD  IR2.4  CAN  ARRIVE  HERE  FRen*  23*16                                 MLEW0444 

TXI  •♦1,4.-1  MLEW044S 

SXC  IR2M1.4  MLEX0446 

TXt  •♦1.4.-1  MLEW0447 

SXO  IR2M2.4  MLEW0448 

TSX  BDWAY.4  MLEW0449 

PZE  IR2M1.2.F0UR  MLEW0450 

CLA»  EXTRA)  MLEW0451 

ST0  DUM  MLEH04S2 

TSX  BDWAY.4  MLEW0453 

PZE  IR2.1.1R2  MLEW0454 

CLA«  A)  MLEli04S5 

ST0  DOMOtiM  MLEW0456 

CLA  1R2M1  MLEW0457 

23A2    TZE  23A4  MUEW045e 

CLA  DUM  .                    MLEW0459 

23A3    TNZ  23Ae  '                    MLEW0460 

23A4   CLA  DUMDUM  CAN  ARRIVE  HERE  FRBM  23A2  MUEW0461 

FSB  GMU  MLEW0462 

FRN  MLEW0463 

LOQ  F0FIM1  MLEW0464 

23A19  TOP  23A20  MLE»(0465 

CHS  MLEM0466 

23A20  ST0  F0FI  CAN  ARRIVE  HERE  FR9K  23A19  MLEW0467 

23A5    TRA  23A12  MLEW0468 

23A6   CLA  in2M2  CAN  ARRIVE  HERE  FRBC  23A3                                  MLEW0469 

23A7   TZE  23A9  MLEW0470 

TSX  B0tlAY,4  MLEW0471 

PZE  IR2M2,2,F9UR  MLEW0472 

CLA*  EXTRA)  MLEW0473 

23Ae   TNZ  23A11  MLEW0474 

23Ag   LOQ  DUM  CAN  ARRIVE  HERE  FR0M  23A7  MLew0475 

FMP  DUM 


FRN 


LLS 

ST0       TEMP 


ICA 


FRN 
FSB 
FRN 


FRN 


MLEW047e 
MLE«0477 


.CO       F0FIM2  MLE<(047e 

MLEW0479 
MLEW04eO 
CLA       DUMDUM  MLEWOABl 

FSB       GMU  MLEW0482 

FRN  MLE-0483 


)484 


FMP       FaFIMl  MLEW0485 


MLEW0486 
MLEM0487 
MLEM04ae 


ST0  F0FI  MLEW0489 

TRA  23A12  MLE..0490 

LCO  DUM  CAN  ARRIVE  HERE  FR0M  23A8                                     MLEW0491 

FMP  DUM  MLEW0492 


MLEW0493 


XCA  MLEW04S4 
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MLEW049S 
MUEWOAQC 
MLEW0497 
MLEw049e 
MLEW0499 
MLEW0500 
ML E WO  SOI 
MLEWOSOZ 
MLEX0503 
MLEW0504 
MLEWC505 
MLElKOSOe 
MLEWOeO? 
MLEWOSOe 
MLEM0S09 
MLEW0510 
MLEMOSl I 
MLEW0512 
MLEW0S13 
MLEW0514 
MLEMOSIS 
MLEM0S16 
MLE»l0517 
MLEdOSie 
MLEM0S19 
MLEVI0520 
MLE«KC521 
MLEX0522 
MLew0523 
MLEW0524 
MLEW0525 
MLFW052e 
MLEW0527 
MLEW052e 
MLEMC529 
MLEW0530 
MLEKC531 
MLEW0532 
.23A22     0R     23A23  MLEWC533 

MLE«l0534 
MLei*0535 
MLE«0S3e 
MLEWC537 
MLEWC538 
MLEH0539 
MLEWOS40 
MLEarC54l 
MLEW0542 
MLE»r0543 
MLEM0S44 
MLEW0545 
MLEW0546 
MLEW0S47 
MLE»(054e 
MLEWC549 


ST0 

TEMP 

CLA 

OUMCUM 

Fse 

GMU 

FRN 

XCA 

FMP 

F0FIM1 

Fse 

TEMP 

FHN 

ST0 

F0FI 

CAL 

F0FI 

ANA 

=0377000000000 

SLW 

TF 

CAL 

F0F  IMl 

ANA 

=0377000000000 

SL» 

TG 

CLA 

TF 

SUB 

TG 

SSP 

sue 

=0200000000000 

23*22 

TPL 

23A12 

23«23 

T^e 

23A  12 

CLA 

TG 

ACC 

=0200000000000 

sue 

TF 

STB 

TG 

CAL 

F0FI 

ANA 

=0400777777777 

0RA 

=0200000000000 

SLW 

F0FI 

CAL 

F0FIM1 

ANA 

=0400777777777 

BRA 

TG 

SLW 

F0FIM1 

CLA 

F0FI 

FAO 

=  00 

ST0 

F0FI 

23A12 

CLA 

F0FI  CAN  ARRIVE  HERE  FRBM  23A5.23A10 

ANA 

=0000777777777 

23*13 

TZE 

23A21 

CLA 

F0FI 

LCC 

F0FIM1 

LLS 

sue 

F0FI 

23*17 

TZE 

2JAie 

23*14 

TRA 

23*15 

23*21 

CLA 

F0FI  CAN  ARRIVE  HERE  FRBM  23*13 

LOG 

F0FIM1 

LLS 

STB 

F0FI 

23*10 

LXD 

10FGMU.4  CAN  ARRIVE  FERE  FRBM  23A17 

TXI 

•♦1.4.1 

SXC 

I 0FGMU.4 

23*15 

CLA 

F0FIM1  CNA  ARRIVE  HERE  FfSBM  23A14 
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ST0 

F0FIM2 

CLA 

F0FI 

ST0 

F0FIM1 

LXD 

IR2,4 

TXI 

•41.4,1 

23*16 

TXL 

23A1 .4  N. 

DECREMENT  SET  IN  2A12 

24 

IF(  I0FGMIj)24.24O3.24Cl 

24C1 

D0  2402 

R=l  .  IBFGU'Li 

2AC2 

CXTRA( IR, 

1  )=MAX1F(EXTRA(  IR.l  )  .GKt) 

24C3 

I£=I0FGML 

4.1 

2A04 

IF(  I0FG^'^. 

-N  )2405.20.2404 

24C5 

00  2406  I 

Rl=I5.N 

2AC6 

EXTRA( IR 
G0  T0  20 

.2)=MlNlF(exTRA(IR1.2) .GKU) 

24/s 

CLA 

I0FG^'U 

2^/>l 

Tze 

24A7 

2'iAe 

STC 

24A5 

AXT 

1  .4 

24/\2 

bXC 

IR.4  CAN 

ARRIVE  HERE  FRBf  24A5 

TSX 

BCMAY.4 

pze 

IR,2.0NE 

CLA« 

EXTRA) 

Fb8 

GMU 

24A3 

TPU 

24A4 

CLA 

GfU 

ST0« 

EXTRA) 

2AA4 

LXD 

IR,4  CAN 

ARRIVE  HERE  FRBV  24A3 

TX  I 

•♦1.4,1 

2AA5 

TXL 

24A2.4  IBFGMU.DECHeWENT  SET  IN  24A6 

2AA7 

LXC 

I0FGMU.4 

CAN  ARRIVE  HERE  Fn0f    24A1 

TX  I 

•41.4.1 

sxc 

15.4 

CLA 

N 

LCG 

I0FGMO 

24A10  LXC 
24A11  SXD 


24A12 

TMI 

24A13 

CLA 

ST0 

24A14 

LXC 

TXI 

24A15 

TXL 

24A10 

24A16 

15.4  CAN  ARRIVE  HERE  FR0H  24A8 

IR1.4  CAN  ARRIVE  HERE  FRgV  24A15 

B0WAY.4 

IRl  ,2.Tt«0 

EXTRA) 


GVU 

EXTRA) 

IRl. 4  CAN  ARRIVE  HERE  FRBN  24A12 

•♦1.4.1 

24A11.4  N. DECREMENT  SET   IN  2A13 

20A1  CAN  ARRIVE  HERE  FRB^  24Ag 

STURM  SEQUENCING  IS  CBMPLETEC 

THE  EIGENVALUES  0CCUFY  EXTRA!. .1) 

00  25  J=1.N 

EXTRA(J.5)=EXTRA(J.4) 


VRRIVE  HERE  FR0M  25A2 


MLEW0550 
MLEW0S51 
MLEW0552 
MLEWCS53 
MLEW0S54 
MLEW0555 
MLEW0S56 
MLew0557 
MLEWOSSe 
MLEI«(0S59 
MLEWCS60 
MLEW05C1 
MLEV»0562 
MLEW0563 
MLEW0S64 
MLE\»0Se5 
MLEK0566 
MLEW0567 

MLExosee 
MLEwoseq 

MLEW0570 
MLEB0571 
MLEX0572 
MLEW0573 
MLEW0574 
MLE»(057S 
MLEW0S76 
MLEIii(0S77 
MLEW057e 
MLEW0579 
MLEWCSaO 
MLEWCSai 
MLEW0582 
MLEX05e3 
MLE«0584 
MLEW0585 

MLEwoeee 

MLEIi«05e7 

MLEwcsee 

MLEW0589 
MLEWC590 
MLEW0S91 
MLEW0S92 
MLEW0593 
MLE«05?4 
MLEW0595 
MLEwC59e 
MLEW0597 
MLElKOSge 
MLEI«0599 
MLEl«i0600 
MLEWOeOl 
MLE»if0e02 
MLEVK0603 
MLEW0604 
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TSX       BDWAY.4  MLEW060S 

pze  J.2.F0UH  MLEwoeoe 

LDI«  EXTRA)  MLEW0607 

TSX  BCWAY.A  MLEWOeOe 

Pie  J. 2, FIVE  MLEW0609 

STI»  EXTRA)  MLEKOeiO 

TXI  •♦1,1,1  MLEWOeil 

25A2        TXL  25A1.1     N, DECREMENT     SET     Ih     2A3I  MLEB0ei2 

D0     26     J=1,N  MLEH0613 

00     2601     J1=1.N  MLEW0614 

2601  EXTRA( Jl  .3)=A( Jl  .  Jl  )-EXTRA( J.l)  MLE«06tS 

00     2602     J1=2.N  MUEWOeie 

EXTRA!  J  1  .2)=EXTRA(  JI-1,S)  MLEtl06l7 

26C2  EXTHA( Jl-1 ,A)=EXTHA( Jl-1 ,5)  MUEw06ie 

MLEWOeiQ 
MLE»»0e20 
MLEX0621 
MLEW0622 
MLE«0e23 
MLE«0624 
MLEM062S 
MLEM0626 
MLEX0627 
MLEN0e2e 
MLEW0629 
MLEH0630 
MLEMOeai 
MLEw0e32 
MLEWC633 
MLE«0e3A 
MLEW063: 
MLEW0636 
MLEHOea? 
MLEM063e 
MLEWOeS? 
MLEW064C 
MLE«064  t 
MLEW06A2 
MLEW0643 
MLEa0644 
MLEW064; 
MLFW064C 
MLE>»0647 
MLFw064e 
MLEW0649 
MLE«06S0 
MLEKOeSl 
MLE«0e52 
MLEW0653 
MLei«06£4 
C0     2701      1=1, KMl  MLF*0e55 

OOM=EXTRA( I ,3)  MLEWOeSC 

Ol,MDLM=EXTRA(  1*1  ,2)  MLEB0657 

IF(  ABSF{DOM)-ABSF(OlJMOtlMJ  )  2902  .  290  3  ,  2<J0  3  ML  EW  06  56 

PIV0T=DLM/OCMOUM  MLEW0659 
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26A 

AXT 

1  .4 

26*1 

sxc 

J, 4  CAN  ARRIVE  HERE  FRBM 

AXT 

1  ,4 

26A2 

SXC 

J1.4  CAN  ARRIVE  HERE  FR0M 

26A3 

TSX 

BOKfAY.A 

PZE 

Jl.  l.Jl 

TSX 

BDKAY.A 

PZE 

J.2.0NE 

CLA« 

A  ) 

FSB« 

EXTRA) 

FRN 

ST0 

TEMP 

TSX 

eCMAY.A 

PZE 

J  1.2, THREE 

CLA 

TEMP 

ST0» 

EXTRA) 

LXC 

J  1  ,4 

TXI 

•♦1.4.1 

26A3 

TXL 

2eA2.4  N, DECREMENT  SET  IN 

2A32 

AXT 

2.4 

26*4 

SXD 

J1.4  CAN  ARRIVE  HERE  FRBM 

26A5 

TXI 

•♦1,4.-1 

SXC 

J  IMl  .4 

TSX 

B0I«AY.4 

PZE 

J1M1,2,FIVE 

LOI« 

EXTRA) 

TSX 

6CWAY.4 

PZE 

J1.2.TIK0 

ST  !• 

EXTRA) 

TSX 

BCMAY.4 

PZE 

J1M1.2.F0UR 

STI« 

EXTRA) 

LXC 

J  1  .4 

TXI 

•♦1.4.1 

26A5 

TXL 

2644.4  N. DECREMENT  SET  IK 

2A33 

27 

EXTRA(  1  ,2 )=0. 
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MI.EM0660 
MLEWOeei 
MLEM0662 
HLEW0663 
MLEW0664 
MLEW0665 

MLEwoeee 

MLEW0667 
MLEM066e 

MLEtioeeg 

MLEW0670 
MLEW0671 
MLEW0672 
MLEW0e73 
MLEW0e74 
eT«EXTRA(  I  ,4)  MLEli(067E 

FIA(I.2)  MLEM0676 

MLEW0677 
MLE»(067e 
MLEW0679 

MLEwoeeo 
MLEwoeei 
MLEwoeez 
MLEwoeej 

MLEW06e4 

MLEwoees 
MLEwoeee 

MLEW06e7 

MLEwoeee 

MLEIi(06e9 
MLEK0690 
MLEW0691 
HLEW0692 
MLE«l(0e93 
MLEW0e94 
MLEIK0695 
MLEM0e9e 
MLEW0697 
MLEI«0e9e 
MLEIII0699 
MLE«0700 
MLEW0701 
MLEW0702 
MLEW0703 
MLEM0704 
MLEW0705 
MLEW070e 
MLEW0707 
MLEW0708 
MLEW0709 
MLEM0710 
MLEW071 I 
MLEW0712 
MLEW0713 
MLEW0714 


EXTRAC  I  ,3)=DUMDLIf' 

DUM=EXTRA< 1.4) 

EXTRA( 1 .4)=EXTRA(I*1 .3) 

EXTRA( I+l .3)=DUM 

EXTRAi  I  .2)=EXTRA(I*1  .4) 

EXTRAC I+l ,4)=0. 

G0  T0  2507 

2903 

IF (DUMDUM) 2906. 2904, 2906 

2904 

IPl=Itl 

00  2905  K=1P1 .N 

2905 

EXTRA(K ,2 )=0. 
Nl=  I 
G0  T0 

2906 

PIV0T=DLMDU»'/OUM 

2907 

EXTRA( I+l .21=0. 

EXTRA(  I  +  l  .3)=EXTRA<  1  +  1.3 )-PIve 

29 

EXTRAC  I  +  l  .4)=EXTRAC I  +  l  .4)-PIve 

27A 

TSX 

BDIIIAY.4 

PZE 

0NE,2.T*0 

STZ» 

EXTRA) 

AXT 

1  .4 

27A1 

SXD 

1.4  CAN  ARRIVE  HERE  FR0M  29A15 

TXI 

•♦1.4.1 

sxc 

tPl  .4 

TSX 

eOUAY.4 

PZE 

I .2, THREE 

CLA» 

EXTRA) 

ST0 

DUM 

TSX 

BDWAV.4 

pze 

IP1,2.T»0 

CLA« 

EXTRA) 

ST0 

DUMCUM 

CLA 

OUM 

SSP 

FSM 

DUMDUM 

27A2 

TPL 

27Aie 

27A3 

TZE 

27Aie 

CLA 

DUM 

FDH 

DUMDUM 

STG 

PIV0T 

TSX 

BCWAY.A 

PZE 

I .2, THREE 

CLA 

DUMDUM 

ST0« 

EXTRA) 

TSX 

BDWAV.A 

PZE 

I .2.F0UR 

CLA« 

EXTRA) 

ST0 

DUM 

27A4 

SXA 

27Ae.2 

TSX 

BDWAY.A 

PZE 

IP1.2.THREE 

CLA« 

EXTRA) 

27A5 

SXA 

27A7,2 

27A6 

AXT 

••.2  ADDRESS  SET  IN  27A4 
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CLA 

CUM 

27*7 

AXT 

••,2  ADDRESS  SET  IN  27A5 

bT0« 

EXTRA) 

TSX 

BDWAY.4 

PZE 

IPl .2.FflUH 

LDI» 

EXTRA) 

STZ» 

EXTRA) 

TSX 

BDWAV.4 

PZE 

I.2.TW0 

STI» 

EXTRA) 

27Ae 

TR* 

27A14 

27A16 

CLA 

OLM  CAN  ARRIVE  HERE  FRBK  27A2  0R  27A3 

27*17 

TZE 

2  7Aie 

27*12 

CLA 

OUMOLM  CAN  ARRIVE  HEBE  FBBM  27A13 

FOh 

DLM 

STC 

PIV0T 

27*14 

TSX 

B0*AY,4  CAN  ARRIVE  HERE  FRBM  27Ae 

PZE 

IP1.2.T«0 

ST2« 

EXTRA) 

TSX 

BD*AV.4 

PZE 

I.2.F0UR 

LDQ» 

EXTRA) 

FMP 

PIVBT 

FHN 

ST0 

TEMP 

TSX 

BCIIlAY.4 

PZE 

IPl. 2. THREE 

CLA* 

EXTRA) 

Fse 

TEMP 

FRN 

STB« 

EXTRA) 

TSX 

BDMAY.4 

PZE 

I.2.TW0 

LCO» 

EXTRA) 

FMP 

PIVBT 

FRN 

STB 

TEMP 

TSX 

BDtlAY,4 

PZE 

IPl,2.FflUH 

CLA. 

EXTRA) 

Fse 

TEMP 

ST0» 

EXTRA) 

27*1B 

LXC 

1.4  CAN  ARRIVE  HERE  FRBM  27A17 

TX  I 

•♦1.4.1 

27*15 

TXL 

27A1.4  NMl .DECREMENT  SET  IN  2*63 

AXT 

1.4 

28*1 

SXC 

1.4  CAN  ARRIVE  HERE  FRBM  28A2 

TSX 

BDMAY.4 

PZE 

I. 2. THREE 

CL*» 

EXTRA) 

LXC 

I  .4 

28*4 

TZE 

2eA3 

TXI 

•  4-  1  ■  4  .  1 

28*2 

TXL 

2eA1.4..«  DECREMENT  SET  IN  2A34 

MLEX0715 
MLEM0716 
MLE«0717 
MLE«07ie 
MLE«0719 
MLEW0720 
MLEW0721 
MLEIK0722 
MLEW0723 
MLEa0724 
MLEX0725 
MLEW0726 
MLEK0727 
MLE»l072e 
MLEB0729 
MLEX0730 
MLEW0731 
MLEW0732 
MLEW0733 
MLEW0734 
MLEB073S 
MLEW0736 
MLEB0737 
MLEw073e 
MLEW073S 
MLE1»0740 
MLE«I0741 
MLEK0742 
MLEW0743 
MLE«0744 
MLE»(074e 
MLE«(074e 
MLEW0747 
MLEW074e 
MLEM0749 
MLEM07S0 
MLEW0751 
MLEW0752 
MLEX0753 
MLEW0754 
MLEB075E 
MLEW0756 
MLEW0757 
MLEw075e 
MLEW0759 
MLEW0760 
MLEW076 1 
MLEa0762 
MLEW0763 
MLEW0764 
MLew0765 
MLEw076e 
MLEW0767 
MLEw076e 
MLEW0769 
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28» 

CLA 

N 

ST0 

Nl 

• 

29 

EXTRA(N1.2)=I. 

• 

N  1M1=N1-1 

28Ae 

TRA 

2qA 

2eA3 

SXC 

Nl.A  CAN  ARRIVE  HERE  FRBM  28A4 

CLA 

N  1 

SUB 

N 

28A5 

TZE 

29A 

TXI 

•♦1  1  A,  1 

28*7 

SXC 

1,4  CAN  ARRIVE  HERE  FRBM  28A8 

TSX 

BCWAY.A 

PZE 

I .2,TW0 

ST2» 

EXTRA  ) 

LXC 

1.4 

TXI 

•♦  I  t4.  1 

2eA8 

TXL 

28A7.4.»«  DECREMENT  SET  IK  2A42 

29A 

TSX 

B0MAY.4  CAN  ARRIVE  HERE  FR0M  28A6  0R28AS 

PZE 

N1.2.TW0 

CLA 

=0201400000000 

STa» 

EXTRA) 

LXC 

Nl.A 

TXI 

SXD 

NlMl  .4 

30A5 

SXC 

31A3,4 

• 

30 

IFCNIMI  )30.32,3001 

• 

300  1 

EXTRA (NIM 1,2 )  =  (  (EXTRA (NI  .  3 ) -E XTR A ( N 1 M 1  .4)  )/EXT 

30A 

CLA 

NlMl 

30A1 

TZE 

32A 

TSX 

BCMAY.4 

PZE 

Nl. 2. THREE 

TSX 

PZE 

N1M1,1,F0UR 

CLA* 

EXTRA2 

Fse« 

EXTRAl 

FRN 

TXI 

•+1  .2.-1 

FDI-» 

EXTRA2 

STC 

TEMP 

TSX 

BDWAY.4 

PZE 

NlMl  .2.Twa 

CLA 

TEMP 

STa» 

EXTRA2 

31 

IF(N1-2)31.32.3101 

3101 

D0  3102  I=2.NIM1 
I1=N1-I 

3102 

EXTRA(I1.2)=(EXTRA(N1,3)-EXTBA(I1*I,2)«EXTRA(I 
X  -EXTRA(I1*2.2)»EXTRA(I1.2))/EXTRA(H,3) 

LXC 

Nl.A 

31A1 

TNX 

32A,4.2 

AXT 

2  .4 

31A2 

SXC 

1.4  CAN  ARRIVE  HERE  FR0M  31A3 

31A 

STZ 

HIGh 

STZ 

L0W 

CLA 

Nl 

MLEl*0770 
MLEW077I 
MLew0772 
MLEW0773 
MLEW0774 
MLEW0775 
MLEW0776 
MLE»(0777 
MLE»(077e 
MLEW0779 
MLEl«07e0 
MLEW0781 
MLEW0782 
MLEI«07e3 
MLEIii(0784 
MLEW0785 
MLE»r078e 
MLEI»07a7 
MLEl»07e8 
MLE»(07a9 
MLEW0790 
MLEW0791 
MLEW0792 
MLEW0793 
MLEB07S4 
MLEW0795 
.3)  MLEW079e 
MLEW0797 
MLE»»079e 
MLEI«(0799 
MLEWOaOO 
MLEW0801 
MLEW0802 
MLEW0e03 
MLEW0804 
MLEW0805 

MLEwoaoe 

MLEW0807 
MLEW0808 
MLEI((0809 
MLEW0810 
MLEWOei 1 
MLEW0812 
MLEW0ei3 
MLEM0814 
MLEW0ei5 
MLEW0816 
MLEW0817 
MLE«(08ie 
MLEW0819 
MLEW0820 
MLEW0821 
MLe«<0e22 
MLEW0823 
MLEX0824 
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MLEwoeas 

MLE«k0826 
MLEW0827 

MLExoaze 

MLEW0e29 
MLEWOeSO 

MLEMoeai 
MLEwoea? 

MLEwOe33 
MLEW0834 
MLEl[l0e3E 
MLEW083e 
MLEl«0e37 
MLEM0e38 
MLEW0835 
MLEx0e4C 
MLEw0e41 
MLE1II0842 
MLElK0e43 
MLEW0844 
MLEwOe«E 
MLEK0846 
MLEW0847 
MLEKOSAe 
MLEw0e49 
MLEW0850 
IAS  MLEM08S1 

MLEwoesz 

MLEK0e53 

MLE«0e54 

SET     IN     30A5  MLEW0855 

32  IF(N-2)32. 3204. 3201  MLEwOese 

3201  OB  3203  K=2.NM1  MLEdOSS? 
K1=N*1-K  MLE*0858 
TEMP=0.  MLEW0859 
00     3202     K2=K1,N  MLEW0860 

3202  TEMP  =  TEMP  +  exTRA(K2.2)«A(Kl-l  .K2)  MLEW08ei 
TEMP=2.»TEMP  MLEW0862 
Oa     3203    K2=K1,N                                                                                                                                       MLEW0863 

3203  EXTRA(K2.2)=EXTMA(K2  .2)-TEMP»A(Kl-l  .K2)  MLEW0864 

3204  TtMP=0.  MLEwoees 
32A  LXC  N.4  CAN  ARRIVE  HERE  FR0M  MLEW0866 
32A1        TNX                  32A7.4.2  MLE«0e67 

AXT  2.4  MLExoeee 

32A2        SXC  K,4     CAN    ARHIVE     HERE     FRBK     32Ae  MLEW0e69 

CLA  N  MLE««0e70 

ACC  UNE  MLEli(0871 

sue  K  MLE«0e72 

ST0  Kl  MLEi*0e73 

ST2  l-IGt-  MLEW0874 

ST^  LdW  MLei«0e7E 

LXD  K1.4  MLEl«0e7e 

32A3        SXU  K2,4  CAN     ARRIVE     hERE     FRBK     32A4                                                                                       MLEl«0e77 

LXC  K1.4  »<LE>»oe7e 

TXI  •♦1.4.-1  MLEli0e79 


SUB 

I 

STB 

I  1 

TSX 

BD*AY.4 

PZE 

1 1. 1. THREE 

TSX 

R0MAY.4 

PZE 

I 1.2.TWB 

SXA 

31A4.2 

L00« 

EXTRA) 

TXI 

•♦1  .2.2 

FMP» 

EXTRA) 

TSX 

LEX. 4 

TXI 

•♦1.2.-I 

LDI* 

EXTRA) 

TSX 

BDWAY.4 

PZE 

I  1  .2.F0UR 

PI  A 

XCL 

FMP» 

EXTRA) 

TSX 

LEX. 4 

TSX 

RCWAY.4 

PZE 

Nl. 2. THREE 

CLS 

HIGH 

FSB 

Law 

FUN 

FAC« 

exTRA2 

FDh« 

EXTRAl 

AXT 

••.2  ADDRESS  SET 

STC« 

EXTRA2 

LXC 

I  .  4 

TXI 

•♦1.4.1 

TXL 

31A2.4  NlMl ,DECR 
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SXC       K1M1,4  MLEHOeeO 

TSX      B0MAY.4  MLEaoeai 

MLEMoeaa 
MLEwoeea 
MLE«(oee4 

MLEwOeSS 

MLEMoeae 
MLEwoee? 
MLENoeee 
MLEMoee? 

MLEW0890 
MLEH0e91 
MLE«0e92 
MLEW0893 
MLEw0e94 
MLei*0895 
MLEW0896 
MLEW0897 
MLEW0e98 
MLEW0899 
MUEW0900 
ML6M0901 
MLEW0902 
MLEK0903 
MLEW0904 
MLEH090S 
MLE«090e 
MLEM0907 
MLEI»090e 
MLEM0909 
HLEW0910 
MLEW0911 
MLEW0912 
MLEM09t3 
MLEW09J4 
TXI  •♦l.^.l  MLEW0915 

32Ae        TXL  32A2.4     N- 1 . DECREKENT     SET     IN    2A68  MLEW0916 

32A7        STZ  TEMP     CAN     ARRIVE     HERE     FRBK     32A1  MLEW0917 

f  D0     33    L=l  .N  MLEW09I8 

>  33  TEMP=TEMP*EXTRA(L.2)««2  MLEW0919 

I  TEMP=SORTF(TEMP)  MLEW0920 

MLEW092I 

MLEW0922 

MLEW0923 

ARRIVE  MERE  FRBM  33A2  MLEW0924 

MLEW0925 
MLEM0926 
MLEI*0927 
MLEW092e 
MLEW0929 
MLE»(0930 
MUEW0931 
J. DECREMENT  SET  IK  2A37  MLEW0932 

MLEII0933 
MLEM0934 


pze 

K1M1.1,K2 

TSX 

BDWAV,4 

PZE 

K2.2.TW0 

LCQ» 

A  > 

FMP« 

EXTRA) 

TSX 

LEX. 4 

LXD 

K2.4 

TXI 

•♦1.4.1 

TXL 

32A3.4  N.OECREMEKT  SET  Ih 

2A36 

CLA 

HIGH 

FAC 

L0I* 

FRN 

ST0 

TEMP 

LOO 

TEMP 

FMP 

=0202400000000 

ST0 

TEMP 

LXC 

Kl.4 

SXO 

K2,4  CAN  ARRIVE  HERE  FRBK 

32A6 

TSX 

BDKIAY.4 

PZE 

K1M1.1.K2 

TSX 

BD1KAY.4 

PZE 

K2.2.T«ia 

LCG» 

A  ) 

FMP 

TEMP 

FRN 

Fse« 

EXTRA) 

FRN 

Ct-S 

ST0« 

EXTRA) 

LXC 

K2.4 

TXI 

•♦1.4.1 

TXL 

32A5.4  N. DECREMENT  SET  IK 

2A35 

LXD 

K  .4 

STZ 

HIGH 

STZ 

L0l« 

AXT 

1  .4 

SXC 

L.4  CAN 

TSX 

BCI.AY.4 

PZE 

L.2.TW0 

LDO» 

EXTRA) 

FMP^ 

EXTRA) 

TSX 

LEX. 4 

LXC 

L  ,4 

TXI 

•♦1.4.1 

TXL 

33A1 .4  1 

CLA 

HIGH 

FAC 

L0M 
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FRN  MLEW0935 

CALL     SORT  MLEl»093e 

ST0  TEMP  MLE»(0<337 

D0     34    L=ltN  MLE«093e 

JO  EXTRA(L.2)=EXTRA(L.2)/TEfP  MLe«0'335 

MLEM0940 
MLEW094I 
MLEH0942 
MLEX0943 
MLEW0944 
MLEM094S 
MLEM0946 
MLEM0947 
MLE«f094e 
MLEW0949 
MLEW09S0 
MLEW0951 
MLEB0952 
MLEH09S3 
MLEW0954 
MLe»(09S5 
MLEH095e 
MLEt»0957 
MLEW0958 
MLEW0959 
MLEM0960 
MLE1(0961 
MLEW0962 
MLE00963 
MLe*(0964 
MLEII096S 
MLEW0966 
MLEK0967 
MLEW096e 
MLEW0969 
MLEW0970 
MLEli0971 

36A1        LXC  J. 4  MLEW0972 

TXl  •♦I. 4.1  MLEW0973 

36A3        TXL  2CA1,4     N, DECREMENT     SET     IN     2A41  MLEW0974 

AXTl        AXT  ,1     ADDRESS     SET     IN     lA  MLEw0975 

AXT2        AXT  ,2     ADDRESS     SET     IN     lAl  MLEB0976 

AXT4        AXT  •••4  MLEW0977 

TRA  e,4  MUE»(097e 

HNt     aCT       OOOCCIOOOOOO  MLEW0979 

TWf!     HCT       CCOC02000000  MLEW0S80 

THREE  BCT       000003000000         ,  MLEI*09ei 

F0LR   aCT       0000040COOOC  MLE«r0982 

FIVE   0CT       OCOCCbOCOOOO  HLFl»09e3 

BCHAY  CLA       1,4  MLEW0984 

STT       1*9  MLEH0985 

STA       •♦7  MLEK0986 

AHS       le  MLEt(0987 

STA       •♦I  MLEl»09ee 

LCC  MLEa09e9 


34A 

AXT 

1.4 

34A1 

sxc 

L.4  CAN  ARRIVE  HERE  FR0|f  34A2 

TSX 

R0MAY.4 

PZE 

CLA« 

EXTRA) 

FDH 

TEMP 

STQ* 

EXTRA) 

LXD 

L.4 

TX  I 

•>  1  .4. 1 

34A2 

TXL 

34AI,4  N. DECREMENT  SET  IN  2A38 

34A3 

CLA 

TAPE 

TNZ 

37A 

D0  35  Jl=l .N 

35 

VEC( Jl. J)=EXTHA( J1.2) 

35A 

AXT 

1  .4 

35A1 

SXD 

J1.4  CAN  ARRIVE  HERE  FR0|v  3SA2 

TSX 

Q0»AY.4 

PZE 

J1.2.TW0 

TSX 

BCl«AY,4 

PZE 

Jl.  l.J 

CLA« 

EXTRA) 

ST0» 

VEC) 

LXC 

J  1  .4 

TXI 

•t 1  .4.  1 

35A2 

TXL 

35A1.4  N. DECREMENT  SET  IN  2A39 

TRA 

36A1 

37A 

CAL 

TAPN 

TSX 

S(ST8) .4 

TSX 

t(SL0) .4 

37A1 

PZE 

••  EXTRA(  1  ,2 ) +  1  .  ADDRESS  SET  IN  1 

37A2 

PZE 

••  N. ADDRESS  SET  IN  2A43 

TSX 

$( WLR) .4 
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ALS 

17 

sue 

N> 

ACD 

PDX 

TZE 

•  +  3 

THA 

2.4 

PZE 

PZE 

LEX 

STQ 

LEXl 

FAC 

h  IGF 

5T0 

HIGH 

XCA 

FAC 

LEXl 

FAC 

Lew 

ST0 

L0* 

TRA 

1  .4 

TAFN 

BZ0L 

77576 

TAPE 

B00L 

77577 

A  1 

800L 

776C0 

LEXl 

e00L 

77601 

A  ) 

Q00L 

77602 

EXTRAl 

e00L 

77603 

EXTRA) 

B00L 

776C4 

VEC  ) 

B00L 

77605 

N 

B00L 

77606 

HICI- 

Be0L 

77607 

L0» 

B00L 

7761C 

TEIVP 

800L 

77611 

GML 

B00L 

77612 

IRl 

Be0L 

77613 

15 

B00L 

77614 

I0FCMU 

Be0L 

776  15 

IR 

B00L 

77616 

Fflfl 

B00L 

77617 

F0F  IMl 

Q00L 

77620 

F0F IM2 

Be0L 

77621 

DVN 

Be0L 

7762i: 

DUMCLiM 

e00L 

77623 

IR£r<2 

B00L 

77624 

IRiMl 

Be0L 

77625 

IRZ 

B00L 

77626 

K2 

8e0L 

77627 

5UBLAM 

B00L 

77630 

SUPLAM 

B00L 

77631 

ILFA 

Be0L 

77632 

a0LND 

b0  0L 

77633 

Jt 

O00L 

77634 

I'. 

B00L 

77635 

L 

b00L 

77636 

NM  1 

B00L 

77637 

NMi 

B00L 

7764C 

JIS  I 

BZ0L 

77641 

LLL 

fl00L 

77642 

C 

Ee0L 

77643 

MLEW0990 
MLEW0?9I 
MLEM0q92 
MLEW0993 
MLEW0994 
MLEW0995 
MLEW0996 
MLEW0997 
MLEW0998 
MLEW0999 
MLEWIOOO 
MLEWlCOl 
MLE»I1002 
MLEW1003 
MLEW1C04 
MLEWIC05 
MLEW1006 
MLEM1007 
MLFWlOOe 
MLEM10C9 
MLEWIOIO 
MLEWIO 1 1 
MLEMIO 12 
MLEWIC 13 
MLEWIO 14 
MLEWIC 15 
MLEW1016 
MLEWIC 17 
MLEWIO 18 
MLEWIO 19 
MLEW 1020 
MLEW1C21 
MLEW1022 
MLEW 1023 
MLEW1024 
MLEW1C25 
MLEW 1026 
MLEW1027 
MLEWlC2e 
MLEW  1029 
MLEW  1030 
MLEW1031 
MLEW 10  32 
MLEW 1C33 
MLEW1034 
MLEW1035 
MLEW1036 
MLEW 10 37 
MLEW103e 
MLEW 10  39 
MLEW 1 040 
MLEW 104  1 
MLEW 1042 
MLEW 104  3 
MLEW1044 


LPl 

800L 

776A4 

BeBL 

77645 

J3 

B00L 

7764C 

12 

B00L 

77647 

FK 

Be0L 

776E0 

J2 

B00L 

77651 

B00L 

77652 

B00L 

77653 

MM 

B00L 

77654 

BBBL 

77655 

s 

B00L 

77656 

STtJH 

B00L 

77657 

K 

B00L 

77660 

Jl 

Be0L 

77661 

I  1 

B00L 

776C2 

IP  1 

Be0L 

77663 

I  IFl 

B00L 

77665 

PlVBT 

800L 

77664 

Nl 

B00L 

77666 

Nlt/1 

B00L 

77667 

I2F1 

B00L 

77670 

Kl 

Be0L 

77671 

KlPl 

B00L 

77672 

KlVl 

BZ0L 

77673 

TF 

B00L 

77674 

TG 

B00L 

77675 

:XTRA2 

SYN 

EXTRA) 

C0f'M0N 

-76 

END 
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MLEW104S 
MLEW1046 
ML  EX  104 7 
MLEM104e 
MLEal049 
MLEW1050 
MLEHIOSI 
MLEW1052 
ML EW  1053 
MLEW1054 
MLEHICSS 
MLEWlOSe 
MLEB1057 
MLEWlQSe 
MLEB1059 
HLEW1060 
MLEM1061 
MLEK1C62 
ML E* 1063 
MLEW1064 
MLEW 1065 
MLEW1C66 
ML  Ex  106  7 
MLE«106e 
MLEX1069 
MLEM1070 
MLEX1071 
ML  E  *  1  0  7  2 
^evEMEER     15.      1963  MLEX1073 
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Identification:     MLEW2  -  Eigenvalues/Vectors  of  a 

Real  Syininetric  Matrix 
FORTRAN  II  Coded  -  7090 
Purpose:   To  compute  all  of  the  eigenvalues  and  eigen- 
vectors of  a  real  symmetric  matrix. 
Method:    This  is  a  FORTRAN  II  version  of  the  FAP  routine 
MLE¥.   Householder's  method  is  used  to  reduce 
the  matrix  to  tridiagonal  form.   The  eigenvalues 
are  then  isolated  using  Sturm  sequencing  and 
the  vectors  are  found  by  Wilkinson's  method. 
Usage:     Entry 

CALL  MLE¥(M,A,VEC,EXmA) 
where 

M         is  the  order  of  the  matrix  to  be  solved 
A         is  the  M  X  M  matrix  to  be  solved.   The 
routine  will  ignore  the  elements  below 
the  diagonal  and  compute  all  the 
eigenvalues  and  eigenvectors  of  the 
real  symmetric  matrix  defined  by  the 
elements  of  the  M  x  M  leading  principal 
minor  of  A  which  are  on  and  above  the 
diagonal 
VEC       is  an  M  X  M  matrix  which  will  contain 
the  eigenvectors.   The  vectors  will 
have  unit  length  and  will  be  stored 
in  the  M  x  M  leading  principal 
minor  of  VEC  from  left  to  right  by 
columns  in  the  order  of  their  corres- 
ponding eigenvalues . 
EXTRA     is  an  M  X  5  matrix  which  will  contain 
the  eigenvalues.   The  values  will  be 
stored  in  the  first  column  of  EXTRA 
in  descending  algebraic  order.   The 
remaining  columns  of  EXTRA  are  used 
as  intermediate  storage. 
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Duplicate  eigenvalues  will  have  identical  eigen- 
vectors computed  for  them.   The  routine  as 
compiled  contains  the  following  DIMENSK/n 
statement : 

DIMENSI0N  A(20,20),  VEC(20,20),  EXTRA(20,5) 
If  different  dimensions  are  desired,  this  statement 
should  be  changed.   The  second  dimension  of  EXTRA 
must  always  be  greater  than  or  equal  to  5. 
Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  MAXl,  MINI,  SIGN 

c)  Storage 

1158,Q  =  22060  locations 
Author:    Sam  Greenspan 
Date:     September  I962 
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* 

LIST8 

* 

LAPEL 

CMLE* 

eiGENVALL 

SUORHUTINE 

DIMENSI0N 

C 

THE  20)S  I 

C 

M  X   M   INPU 

c 

Ab0VE   AND 

c 

DIMENSI0NS 

c 

EQUAL  20. 

c 

C0MPUTE  AL 

CLEWS  -  E IGENVALLES/veCTeRS  0F  A  REAL  SYKVETBIC  MATRIX  -  FBRTRAh 


FMLKCOIC 

FMLWC020 

;S/VECT0RS  0F  REAL  SVVKETRIC  MATRIX   F0RTRAN  II  VERSIBN  FMLW0030 

MLEW  ( M,A, VEC .EXTRA)  FMLW0040 

K20.20).VEC(20.20),exTRA(20.5)  FML*00  50 

J  THE  AB0VE  DIMENSIKN  STATEMENT  MUST  BE  CHANGED  IF  THE  FMLW0060 

r  MATRIX,  0R  AT  LEAST  TI-AT  PART  gF  THE  INPUT  MATRIX  FMLW0070 

5N  THE  DIAG0NAL,  IS  NBT  ST0fiED  IN  AN  ARRAY  A  0F  FMLWOOeO 

20  X  20  IN  THE  LSLAL  FeRTRAN  MANNER  WITH  M  LESS  0R  FMLW0C90 

MLEW  WILL  IGN0RE  THE  ELEMENTS  EELKW  THE  DIAG0NAL  AND  FMLWOIOC 

.  EIGENVALUES  AND  VECT0BS  FZR  A  REAL  SYMMETRIC  INPUT  FMLWOllO 

C       MATRIX  DEFINED  BY  THE  ELEMENTS  0F  THE  M  X  M  LEADING  PRINCIPAL  FMLW0120 

C       MIN0R  0F  A  WHICH  ARE  0N  AND  Ae0VE  THE  OIAGBNAL.    DUPLICATE  FMLW0130 

C       EIGENVALUES  WILL  HAVE  IDENTICAL  EIGENVECT0RS  C0MPUTED  F0R  THEM.  FMLW01*C 

C       THE  EIGENVALUES  ARE  ST0RED  IN  THE  FIRST  C0LUMN  0F  EXTRA  IN  FMLW0I50 

C       DESCENDING  ALGEBRAIC  0HDER.    THE  EIGENVECTeRS  WILL  HAVE  UNIT  FMLW0160 

C       LENGTH  AND  ARE  ST0RED  IN  THE  M  X  M  LEADING  PRINCIPAL  MIN0fi  0F  VEC  FMLwOl/C 

C       FH0M  LEFT  T0  RIGHT  BY  C0LLMNS  IN  THE  BROER  0F  THEIR  C 0RRESF0NO I NG  FMLW0180 

C       EIGENVALUES.  FMLW0190 

EQUIVALENCE  ( TE.  ITE) .( TF, ITF)  .(TG.ITG)  FMLW02C0 

N=M  FMLW021C 

NM1=N-1  FMLWC220 

IF  (N-2)1.2.3  FMLW0230 

J      NM2=N-2  FMLW024C 

00  33  L=1.NM2  FMLWC250 

S=0.  FMLWC260 

LP1=L+1  FMLWC270 

D0  10  K=LPl,N  FMLW0280 

10     S=S+A(L,K )»»2  FMLW029C 

ST0H=SQRTF( S )  FMLWC30C 

DUM=A(L.LP1)  FMLW0310 

EXTRA(L.4)=-SIGNF( STBH.DUM)  FMLW0320 

14  IF  (S)   14,33.15  FMLW0330 

15  C=  !./( 2.»(  S  +  ABSF(DUM)»ST0H)  )  FMLWC34C 
A(L,LP1 )=DUM-EXTRA(L,4 )  FMLW0350 
D0  23  I=LP1,N  FMLW0360 
DUM=0.  FMLW037C 
D0  23  MM=LP1.N  FMLW038C 
IF  (I-MM)  20,20,22  FMLW039C 

20     DUM=CUM  +  A(  I  , MM  )»A  (L, MM  )  FMLW0400 

G0  T0  23  FMLW041C 

22  DUM-DUM+A( MM, I )»A(L.MM)  FMLW0420 

23  EXTRAC I , 4 ) =DUM  FMLW0430 
FK=0.  FMLW044C 

I  FMLW045C 

EXTRA(J2,4)  FMLW0460 

FMLW0470 

,  FMLWOASO 

:TRA(  12,4  )-FK«A  (L  .  I  2  )  FMLWOAgO 

FMLWCSOO 

FMLWC5 10 

J3)-(A(L,I3)»exTRA(J3.4)tA(L,J3)«EXTRA(I3,4))«2.»C  FMLW0520 

FMLWC53C 

,M  FMLWCE4C 


26 

J2=LP1 , 

=FK+A(L, J2) 

=  C»FK 

29 

I2=LP1 . 

TRA 

12,4 )=E 

32 

I3=LP1  . 

^2 

J3=I3.N 

13. J3)=A( 13 

SOR 

rF  (c ) 

16 

LLL=LP1 
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GMU=(EXTRA(t 

191 

IF(exTRA(K2 

19Z 

IF  (GMU-EXT( 

19C 

C0NT INLE 

G0  T0  4 

yLew2  -  E  IGENVALueS/veCT0RS  BF  A  REAL  SYKHETRIC  MATRIX  -  FBRTRAK  II  C0CED 

)     A(L.LLL)=C»AIL,LLL)  FMLW0550 

!     C0NTINLE  FMLX0560 

EXTHA( N-1 ,A )=A(N-1 .N)  FMLW0S7O 

EXTRA(N.A)=0.  FMLX0580 

e0UNO=A8SF(A(l,l))+ABSF(EXTRA(l.4))  FMLK05  90 

D0  100  14=2, N  FMLK0600 

AB0LND=ABSF(A(I4,I4))+ABSF(exTHA(I4,4))+AeSF(EXTRA(I4-1.4))  FMLW06  10 

)0   B0UNO=MAX IF ( eaUNO , AB0UND)  FMLW0620 

00  150  J4=1.N  FMLW0630 

eXTRA( J4. 1 )=-BauND                 -  FMLK064C 

iO   EXTRA(  J4,2  )=e0UND  FML«<0650 

ILFA=0  FMLW0660 

iC    ILFA  =  ILFA+1  FML»l0670 

D0  190  K2=1.N  FMLW068C 

:2,2)+EXTRA<K2. 1 ) )/2.  FMLW0690 

2)-G>'U)   191,190.192  FMLW0700 

IA(K2,1))   192.190.210  FMLW0710 

FMLK0720 
FMLW0730 

21C   0NE=1.  FMLW074C 

I0FGMU  =  O  FML1I0750 

F0FIM1  =  1.  FML«r0760 

D0  2400  IR2=1.N  FMLW0770 

OUM  =  EXTRA(  IR2-1  .4  )  FMLI*07eO 

OUMCUM=A( IR2, IR2)  FMLW0790 

6      IF  (  IR2- 1  )e.  1300.  1200  FMLW0800 

1200  IF  (DUM)   1500.1300,1500  FMLK0810 

1300     F0FI  =  (  DUMCOM-GMU)»SIGNF(  0NE  .FKFIMl  )  FMLIK0820 

G0  T0  2000  FMLB083C 

15C0  IF( IR2-2) 1500. 1700.1600  FMLW084C 

16CC  IF(EXTRA( IR2-2.4) )   1900,1700.1900  FMLH0850 

17C0  F0FI=(DUMCUM-GMU)»F0FIM1-SIGNF (DUK««2.F0FIh'2)  FMLW0860 

G0  T0  2000  FML«l0e70 

19CC  F0FI  =  t  Ol-MOLM-GMU)»F0FIMl-OLM»«2»FeFIM2  FMLWOeSO 

3       TE=20000C000000  FMLK0890 

3       TF=F0F  1*377000000000  FML»l0900 

3       TG=F0F IM1»377000000000  FMLX0910 

IF(  XABSFC  ITF- ITG)-I  TE  )  2  1  C  1  ,  2C  00  ,  2  000  FML1»0920 

21C1   ITG=ITG*ITE-ITF  FMLK0930 

3       F0FI=( F0FI«4OO777777777)+TE  FMLW094C 

3       F0FIMl=(F0FIMl«4OO777777777)+tG  FMLX0950 

F0FI=F0FI4C.  FMLlrlC960 

20CC  IF  (F0FI)  2100.2500.2100  FMLW0970 

2100  IF  ( SIGNF(F0F I .F0F IMl )-F0F I )  2  300.2200.2300  FMLW0980 

2500  F0FI=S IGNF (F0FI .F0FIM1 )  FMLW0990 

2200  I0FGML  =  I0FGMlj+ I  FMLWICOO 

2300  F0FIM2=F0F IMl  FMUWIOIO 

2400  FaFIMl=F0FI  FMLW1C20 

290    IF( I0FCMU)29O.25O.23O  FMLBIC30 

230   00  240  IR=1.I0FGMIj  FMLW104C 

24C   EXTRA(  IR,  1  )=MAXlF(exTRA(  IR. 1  )  .GMU)  FMLW1C50 

250    I5=I0FGMU+1  FMLW1060 

300    IF{ I0FGMU-N)26O. 280.300  FMLW1070 

260   00  270  IR1=I5.N  FMLWlCSO 

270   EXTRA(  IRl  ,2)=MIN1F(EXIRA(  IRl  .2)  .GKL)  FMLlilC90 


•w2  -  EIGENVALLES/VECT0RS  0F  A  REAL  SYKMETBIC  CATBIX  -  FBRTRAN  II  C0DEO 

G0  TZ  2e0  FML*1100 

00  4101  J=1.N  FMLWlllO 

eXTRA( J,5)=EXTRA( J,4)  FMLW1120 

00  OOZt     J=1.N  FMLW1130 

00  4021  J1=1.N  FMLB114C 

EXTRA(JI,3)=A(J1,J1)-EXTRA(J,1)  FMLW1150 

00  4022  J1=2,N  FMLW1160 

eXTRA(Jl,?)=exTRA(Jl-1.5>  FML»(1170 

EXTRA(J1-1,4)=EXTRA(J1-1,5)  FMLB 1 180 

EXTRA( 1 , 2 ) =0.  FMLW119C 

00  SOD  1=1, NMl  FMLW1200 

OUM=EXTRA( I , 3)  FMLW1210 

DUMCUM=EXTRA(  I»l  ,2)  FMLI»1220 

IF(ABSF(OUM)-ABSF(OUMOUM)»50J.502.502  FMHill230 

PIVZT  =  DUM/OUMOUM  FMLlil24C 

EXTRA(  I  ,  SJ^OLMRUW  FML1II1250 

CUM  =  EXTRA(  I  ,4  )  FMLK1260 

EXTRA( I ,4)=EXTRA( I+l ,3)  FMLW1270 

exTRA(  1+ 1  .  3  )=OUM  FML»ll2eO 

EXTRA(  I ,2)=EXTRA{  I +  1  .4)  FML*12qO 

EXTRA(  It  1  .4  )  =0.  FMLIII1300 

G0  T0  4017  FMLW1310 

FMLWI320 

FMLW1330 

FMLW134C 

.3)-PI veT»EXTRA( 1,4 )  FMLW1350 

,4 )-PI VeT»EXTRA( I ,2)  FMLW1360 

FMLW1370 

FMLWlSaO 

,600  FMLIII1390 

FMLWMOO 
FMLW 1410 
FMLW 1420 
FMLW1430 
FMLIK1440 
FMH«1450 
FMLW 1460 
FMLW1470 
FMLW1480 
FMLW1490 

12  IF  (NlMl)  12,7,4014  FMLW1500 
40  14  EXTRA(N1M1,2>  =  (EXTRA(N1,3)-EXTRA(MN1,4))/EXTRA(N1M1,3)  FMLW1510 
11     IF   (Nl-2)   11,7,13                                                               FMLK1520 

13  00  4015  1=2, NlMl  FMLW1530 
I1=N1-I                                                                            FML«II1540 

4015  EXTHA(11,2 )  =  ( EXTRA (Nl ,3)-EXTRA(Il  +  l,2)»EXTRA(Il  ,4)-EXTRA(  I  1 +  2 , 2  )  •EFMLW 1 5  50 

XXTHA(I1,2))/EXTRA(I1,3)  FMLWIS60 

7      IF(N-2)7,e,4029  FMLli(1570 

4029  00  4027  K=2.NM1  FMLW1580 

K1=N+1-K  FMLW1590 

T£MP=0.  FMLW1600 

00  4023  K2=K1,N  FMLW1610 

4023  TEMP  =  TE:MP  +  EXTRA{K2,2)»A(K  1-1  ,K2)  FMLW1620 

TEMP=2.«TEMP  FMLW1630 

00  4027  K2=K1,N  FMLli»164C 
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502 

IF  (OUM)  407,500.407 

407 

PIV0T  =  CUMDljM/DUM 

4017 

EXTRA(  I  +  l,2)  =  0. 

EXTHA(  I  +  1.3)=EXTRA(  I  +  l 

EXTRA( I+l .4)=EXTRA( 1*1 

50C 

C0NT iNue 

00  eoo  1  =  1  ,N 

IF(EXTRA( I , 3) )  600.601 

600 

C0NT INUE 

N1=N 

G0  T0  401C 

60  1 

N1=I 

IF  (Nl-N)  602,4010,602 

602 

NIP  1=N 1  +  I 

00  603  I=N1P1,N 

603 

EXTRA! I,2)=0.0 

4010 

EXTRA( M ,2  )  =  1  . 

41C0 

N1M1=N1- 1 

IXLEM2  -  EIGENVALUeS/VECTBRS  0F  A  REAL  SYXHETRIC  MATRIX  -  FBHTHAN  tl  C0OEO 

40Z7  EXTRA(K2.2)=EXTRA(K2.2)-TEMP«A(KJ-1 ,K2)  FMLKI650 

e      TeMP=0.  FMLW1660 

A031  Da  A032  L=1,N  FML«»1670 

4032  TEMP=TeMP+EXTRA(U.2)»«2  FMLW16eO 

TEMP=SQRTF(TEMP)  FMLW1690 

D0  737  J1=1.N  FMLW1700 

737   EXTRA( Jl .2 >=EXTRA( Jl ,2)/TEMP  FML«1710 

4028  00  4026  J1=1.N  FMLW1720 

4026  VEC( Jl , J)=EXTRA( Jl ,2)  FMLM1730 

1      RETURN  FMLW1740 

END  FMLW1750 
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Identification:      EIG5  -    Eigenvalues  of  Real  Matrices 

FORTRAN  II  Coded  -  709O 
Purpose:   To  find  M  (_<  N)  of  the  eigenvalues  of  a  given 

real  N  x  N  matrix  A  for  2  <  N  <  100. 
Method:    Reduce  A  to  Hessenberg  (almost  triangular)  form 
H  by  elementary  similarity  transformations.   The 
characteristic  polynomial,  det  (H-zI),  and  its 
derivatives  are  evaluated  by  an  extension  of 
Hyman's  method.   Each  eigenvalue  of  H  (and  so 
of  A)  is  found  iteratlvely  using  a  modification 
of  Laguerre's  method. 
Input:     A  must  be  stored  in  core  memory.   Because 

FORTRAN  II  does  not  allow  variable  DIMENSI0N 
statements  in  subroutines  the  dimensions  of  A 
and  the  vector  of  eigenvalues  in  the  main 
program  must  be 

DIMENSI0N  A (100, 100),  RR(lOO),  Rl(lOO) 
If  different  dimensions  are  required  then 
numbers  >  100  in  the  DIMENSI0N  statements 
must  be  changed  accordingly  in  EIG5  and  its 
subroutines  HESS,  LAG,  and  TOACE . 
Output:    The  condition  of  each  eigenvalue  can  be 

judged  from  the  successive  iterates.   If  this 
information  is  not  wanted  then  the  user  may 
set  PRINT  =0,0  which  suppresses  the  printout. 
If  PRINT  7^  0.0  the  following  will  be  written 
on  output  tape  6  for  printing: 
Trace  of  A 
Trace  of  H 
Successive  Iterates  and  the  values  of 

|P|^,  \?'\^,     |P"|^,  No.  of  overflows. 
Eigenvalues  and  the  test  passed 
Sum  of  Eigenvalues 
Here  the  current  iterate  is  z,  P(z)  =  det(H-zI), 
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I  largest  eigenvalue 


10-°|z|-|P'(z)| 

10-5-5  max  (Izl,  IQ-^L) 

10-6  L  (for  multiple  roots) 


Az  =  change  in  z 
found  so  far | . 

Test  1   |P(z)  I 

Test  2   |Az| 

Test  3   |Az| 
l6  iterations  =  failure  to  converge. 
Usage:     Entry 

CALL  EIG5(A,M,N,RR,RI,STARTR,STARTI, PRINT) 
M  eigenvalues  of  the  N  x  N  matrix  A  are  stored 
in  vectors  RR  and  RI  containing,  respectively, 
the  real  and  imaginary  parts .   STARTR  +  i  * 
STARTI  is  the  initial  guess  at  the  first  eigen- 
value.  If  STARTO  >  l.E+35  then  EIG5  will  produce 
a  good  guess  at  the  eigenvalue  of  largest 
absolute  value  (in  general)  and  use  it.   This 
is  the  recommended  usage  unless  there  is  some 
a  priori  information  about  the  eigenvalues  or 
unless  it  is  desired  to  begin  the  search  at  a 
particular  point  of  the  complex  plane,  such  as 
the  origin. 
Accuracy:  This  depends  both  on  the  proximity  of  the 
eigenvalues  and  on  their  condition.   All 
computed  eigenvalues  of  a  l6  x  l6  (40  x  4o) 
matrix  had  errors  less  than  76  (IO76)  in  the 
last  digit  and  such  errors  occurred  in  the 
small  eigenvalues . 

Time:     Theoretically  5/6  N-^  multiplications  are 

2 
required  to  transform  A  into  H,  and  then  3N 

multiplications  per  iteration  in  the  complex 

plane.   On  the  average  3  iterations  should 

suffice  for  each  simple  eigenvalue  which  is 

not  too  ill-conditioned.   In  practice  times 

required  to  find  all  eigenvalues  of  matrices 

of  order  10,  16,  40,  64,  100  were  .04,  .09, 

.91,  4.75,  12  minutes  respectively. 
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Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

The  routine  also  uses  a  subroutine  FPT  to 
handle  overflow  conditions  and  the  subroutines 
necessary  to  write  an  output  tape.   These 
routines  are  discussed  more  fully  In  the  last 
section  of  this  report. 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  FL0AT,  MAXl,  MINO,  MINI,  SIGN,  XFIX, 
XMINO,  XM0D 

c)  Storage 

3375-1 Q  =  ^^'^'^8   locations  plus  the  required 
subroutines  listed  In  a) . 


Reference:   "Applications  of  Laguerre's  Method  to  the 
Matrix  Eigenvalue  Problem,"  Mathematics  of 
Computation,  1964. 

Author:    B.  N.  Parlett 


Date:     December  I963 
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CALL  1 

RACE 

(A.N 

.PR  INT 

CM  10 

1=2. 

GANMA 

I-  I  ) 

=  A(  I 

-1  .  I  ) 

GAN^A( 

t-J  )=:0 

ATiUX 

RECLCED. 

DISPE 

EIGS  -  eiGENVALLES  BF  REAL  ^'ATRICES  -  FgRTfiAN  II   CeCEC 

C  EIG5  SLEH0LTINE  /  EIG5  PART  1  BF  5  E I G5000 1 

SUeWULTINE  EIG-aC A.V.N, RR.RI  .STASTP .STABTI  .PR  INT  )  EIG5C01O 

C  THE  NXN  REAL  .viATRIX  A  IS  REDUCED  TK  HESSENeERC  F0RV  BY  l-ESS.  f     EIGEN-  EIG50020 

C  VALUES  RR(  J  > +  !•«  I  (  J)  ARE  F0LiND  BY  LAGLERRE'S  f'ETheC  USING  ThF  HESSEN-  EIGS0030 

C  BfcRG  FURM  T0  EVALUATE  THE  CHARACTERISTIC  PBLYNe^'IAL  AND  DERIVATIVES.   EIG500AC 

C  IF  PRINT=0.  THERE  WILL  BE  N0  PRINT  0UT.  EIG50050 

C  see  LAG  FUR  THE  MEANING  0F  STARTR  AND  STARTI.  EIG50060 

DIMENSI0N  A{  ICO.  ICO)  .HR(  ICC)  ,h  I  (  ICO)  ,GA^<^/A  (  100)  EIG50070 

CALL  TRACE ( A ,N .PR  INT  )  eiG50080 

CALL  HESSC A.N. SIZE .PRINT )  EIG5009C 

E IGbOlOO 
EIG5C1 10 
EIG50120 
EIG50130 
iSE  WITH  LAG  FBR  1X1   AND  2X2  MATRICES.  EIG50140 

EIG50150 

EIG50160 

i)20.7S.?5  EIG50170 

EIGSOieO 
EIG50190 
EIG50200 
eiG50210 
EIG50220 
EIG50230 
EIG5O240 
EIG50250 
eiG5026C 
EIG50270 
EIG502aO 
EIGS0290 
eiG5030C 
EIG50310 
EIG50320 
EI G50330 
SPURl .SPUR2. PRINT.  FIG5034C 
EIG5C350 
eiG50360 
E1G50370 
E  IG503aC 
EIG5C390 
E I G50A00 
EIGS0410 
EIGS0A20 
EIG50430 
EIG50A40 
EIG50A50 
E I G50460 
EIG50470 
EIG504eO 
EIGbOAqO 
EIGb0500 
EIG505JO 
EIGSC£20 
EIG50S30 
EIG5054C 
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NU=NV 

25 

IF(GAyMA(NV) )   30.35 

30 

30 

NV=NVt  1 
G0  T0  25 

35 

IF(NV-NU-1  )eC  .46.40 

OC 

MM=XMIN0F(NV.M) 
CANMA(NV)=-1.0 

FIND  THE  TRACES  0F  THE 

SUB 

MATRIX  A 

ND 

I  TS 

SQUARE 

NU1=NU+ 1 

1  1 

SPUR 1=A(NU.NU ) 
SPUR2=SP0R1«»2 
D0  42  J=NUI.NV 
T=A( J. J) 
SPUR1=SPUR1+T 

42 

SPUR2=SPUR2*T«»2+2.«A(J-l. 

J) 

•A(  J.  J 

- 1 

45 

CALL  LAG(A. GAMMA, RR 

.RI 

.NU. 

N  V 

.MM. ST 

ARTR,S 

TARTI  .S 

ISIZE) 

G0  T0  15 

'It 

S=.5«(  A(NU  .NU  )-t-A(NV 

.NV 

)  ) 

DIS=( .5»{ A(NU,NU)-A 

NV 

.  N  V  ) 

)  ) 

••2+A( 

NU 

NV) 

•A(NV .N 

T=SGRTF( ADSF(CIS) ) 

IF(C  IS>5C,£5,S5 

EO 

RRINU  )=S 
RI(NU)=T 
RR(NV)=S 
RI (NV ) =-T 
G0  T0  £5 

£5 

R«(NU)=StS  IGNF(T,S) 
RI(NU)=0. 

RH(NV)=(S*»2-CIS)/RR(NU) 

RI(NV)=0. 

G0  T0  t5 

eo 

RR(NU) =A (NU,NU ) 
RI (NU)=0. 

t5 

1F(PHINT )70. 1S.7C 

7C 

WRITE  0UTPUT   TAPE  6 

.1  . 

(RR  ( 

J) 

,(•1  (  J) 

.J 

-NU. 

NV) 

EIG5  -  EIGENVALUES  eF  PEAL  MATRICES  -  F0RTRAN  II  CeCEC 


G0  T0  15 

S  =  0. 

o«  eo  J= 1 .M 

S=S+RR( J ) 

IF  (PRINT)  85,90.85 

WRITE  0UTPLT  TAPE  6.2,S 

RETLRN 

F0RMAT(  1  1  HOE  I  GEN VALUE, 12X.2E2C.8) 

F0R^'AT  (  /  ,3ex  ,20HSLM  0F  EIGENVALUES  =E16. 

ENC 

eiG5  SUERauTINE  /  HESS  PART  2  eF  5 
SUBROUTINE  HESS( A,N,SB,PRINT ) 
REDUCTI0N  0F  THE  FULL  NXN  MATRIX  A  T0  LB 
ELEMENTARY  SIMILARITY  TRA  NSF  0  S  ^/ A  T  I  KNS  *  I 
BEC0ME  THE  ADS0LUTE  VALUE  ZF  THE  CREATES 
DIMENS I0N  A( ICO. 100) 
Sb=ABSF( A(N,N) ) 
N1=N-1 
N2=N-2 

D0  29  J=l  ,M 
SA  =  0. 

D0  9  K=l , J 

SA=MAX1F(SA,A83F(A(J,K))) 
J1  =  J+1 
J2=J+2 

S=AeSF( A( J, Jl ) ) 
L  =  J  1 


5  HESSENBERG  F0B^' 
INTERCHANGES.  SE 
ELEMENT  0F  A. 


NJ  1 


Jl 


IF  ( N  J  1  )   10,10,11 

SB=MAX1F(S  ,SA,ABSF(A(N.N-1  )  )  ,Se) 
IF(  S- 1  .E-e«SA )  20,20.23 
FINC  THE  P1V0T  IN  R0«i  J 
DM  13  K=J2,N 
T=ABSF( A( J,K) ) 
IF(T-S) 13,13.12 
L  =  K 
S=T 

C0NT INUE 

IF(L-Jl)M.ie.lA 

INTERCHANGE  R0WS  AND  C0LU^^S  J+1  AND  L 
00  15  K= 1 ,K 
T^AtK, J+1 ) 
A(K, J* 1  )=A{K,L) 
A(K,L  )  =  T 
D0   17  K=  1  ,N 
T=A{ J+1 ,K) 
A( J+1 ,K)=A(L,K) 
A(L.K)=T 

SB=MAX1F(S.SA.ABSF(A(N,J) ) .SB) 

SEE  IF  MATRIX   IS  REDUCED. THEN  FINC  MULTIPLIERS  AND  UPDATE  R0» 
IF(S-l.e-e«SA)20.20.21 
A( J, J*l )=C. 
NJ  1=0 
G0  T0  23 

IF  <NJ1 )  23,23,215 


EIG50550 
EIG50560 
EIG50570 
ElGSOSaO 
EIG50S90 
EIG50600 
EIGSCeiO 
EIG50e20 
EIG50630 
EIG50640 
EIG50650 
EIG50660 
EIG50670 
EIG50680 
EIG50690 
EIG50700 
EIG50710 
EIG50720 
EIG50730 
EIG507AC 
EIGb0750 
EIG50760 
EIG50770 
EIG50780 
EIG5079C 
EIGSOeOO 
EIG50810 
EIG50820 
EIG50830 
EIG50840 
EIG50850 

EiGsoeeo 

EIG50e70 

EiGsoeao 

EIG50e90 
EIG50900 
EIG50910 
EIG50920 
EIG50930 
EIG50940 
EIG50950 
E1GS0960 
EIG50970 
EIG50980 
EIG50990 
EIG51000 
EIG510 10 
EIG51020 
EIG51C30 
EIG51040 
EIG51C50 
EIG51C60 
EIG51C70 
EIGSlOeO 
EIGblC90 
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T  =  A( J, J  I  ) 

C0  22    K=J2.N 

A(  J,K)=A(  J  ,K  )/T 

CU  29  1=1 .N 

M  =  Xr'  tNCF  (  J  ,  I-ir  ) 

s  =  c. 

If-(NJ1  )26, 26.24 

Ca  2=  K=J2.N 

S=S+A(K, I )«A( J.K) 

IF(M)2g,2  9.27 

DIO  23  K=l.l>' 

S=S-A(K. I )«A ( Jl ,K+ 1 ) 

A(  Jl  ,  I  )=A(  Jl  ,  I  )+S 

IF(PRINT ) 31 .32.  31 

l»f<ITe  MUTPLT   TAPE  6.1. 

RtTLHN 

F09MAT( lH0.iex.22HALWHS1 


TRIAhGLLAR  FePM) 
3  eF  5 


EIGi;     Sl^EHZLriNE     /     TRACH     PAh^ 

SUORHUTINt   TR4CF ( A ,N .PRINT ) 

OlfENS IHK   A( 100. ICO ) 

IFtPRINT  )  1C.3C.  IC 

5.  =  0. 

C^  20  J= I .N 

S=S+A( J. J ) 

WKITE     fJLTPLT     TAPE     6.1.S 

KETUi^N 

FURWAT ( IbC .«ex. 7FTRACE  =£16.8) 

ENC 

EIG5  SLEHKtTINE  /  LAG  FART  A  KF  5 

SUPRHOTINE  LAG(A,GA,RR.RI .NlJ.^V.^^.STR.STI .SPl .SP2.PH,SZ) 
IGENVALUES  RR(  J)-H»RI  t  J)  0F  THE  PRlNCIf-AL  SUGyATRIX  (NU.NUI 
,NV)  0F  A  ARE  F0UND  BY  LAGLERRE'S  NETHKC.   ThE  SEARCH  BEGINS 
H.  HBWEVER  IF  STR  IS  GTR  THAN   1.E35  TFFN  THE  PR^GRAy  PH0V1 

jS  at  a  rout  0f  maximal  wbgllls. 

DIN'EKSIHN     A(lC0.1CO).OA(lCC).fiT(lCC),f;t(100).P(6.l01).B(61 

CALL     FPTFST  (  I8VFL  ) 

IF (PR ) 3. A. 3 

*R1TE  auTPUT  TAPE  6.2. 

SL«*=0. 

NUC=NU- 1 

ITS=0 

EGSLM1=0. 

EGSLr'2  =  C. 

CUP=.2=»SZ 

CAP= I .e- lfc»SZ»»2 

OH    s    j  =  ;r.e 

P(  J..NL  )=C. 


STA,:)TING     VALLf. EITHER     GIvEt 
\y  (  STI--  1  .K  ♦3£  )6.  7.  7 


^P     THE     ITERATE     eF      INFIMl 


eiGsiioo 

EIG51 1 IC 
EIG51 120 
El G5  1  130 
EIG51 140 
E IG51 150 
EIG51 160 
EIG51 1 70 
EI Gbl leC 
EIGbl 19C 
EIG5 1200 
EIG5121C 
EIG51220 
EIG5123C 
EIG512AC 
EIG51250 
EIG5126C 
EIGbl 270 
EIGbl275 
EIGbl2e0 
E  I  G  5  1  2  9  0 
EIGblJCO 
EIG51310 
EIGbl320 
EI  G51330 
EIGbl3AC 
EI Gbl350 
EIG5l3eC 
FIG51370 
ElCbl 380 
El G51390 
<eLGHEI Gb lAOO 
STR+EI GblA 10 
A  EIG51A2C 
EI GblA 30 
EI Gb 14  AC 
EIG51450 
E  I  G  5  1  4  6  C 
E  I  G  5  1  4  7  0 
EI G514eC 
FI Cbl490 
EIGblSCC 
EIG5151C 
EIGb 1520 
EIG51530 
EIGbl=40 
EIGblbSO 
E  I  r  5  1  5  6  0 
EI Cb 1570 
EIGblSeC 
E  I  G  b  1  5  9  0 
EIGbieOO 
EIC51610 
E 1 Gb 162C 
E I G5  1630 
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eiCENVALLES     ^F     REAL     I^ATHICES 


FliRTHAN     II     CeCEC 


S1W=CGSUVI- 

-SPl 

5^hi  =  SP2-EG! 

:l,fi! 

F 1=NV-NC0 

IF(  AriiF  (  sn 

?)+ABSF(S2R)- 

X  =  CUM 

Y  =  0. 

G0    Ta    It 

Dl<=  (F  1-1  .  )i 

»(F 1«S2R- 

-SIM 

FR  =  SQrtTF  (  AQSF  (  OH  )  ) 

IF(CR)  10.  1  1.  1  I 

X  =  -S1R/'F  I 

1  .e-8«22)o,e,q 


X=-(5  1R*SICNF(ER,S1R))/F1 
Y=0. 

IFCNOQ-NL+ITSJlS.ll.M 
X=  1  .75»X 
Y=l  .75«Y 


CHARACTERISTIC     PBLYNPMAL     ANC    OEHlVATIVEi 


P(  1  .NU  )  =  1  .0 

IF(AQ5F(Y)-l.t-5»ABSF(X)  )  15.1<;.1'3 

Y  =  0. 

Dw  le  j^A.e 

f((  J)=0. 

on  2t  K=NL,NV 
00  26  L=  1  .M 
Ib  =  XSIGNF(  1  .2-L) 
Ll=L+3« IS 

R  =  -X«P(L,K)  +  Y«FL(aATF{IS)»P(LI,K)-FL4!ATF(Xli'0CF{L-l,3))«P(L-I.K> 
Uk)  21  J  =  NL.K 
R=R  +  P(L. J )*A{K 1  J) 
P(L.K+  1  )=-R/GA(K) 

IF   (HVFL)  22.26.22 
HVFL=0. 


IH  = 


CH   24   I=NL.KP1 

00  2A   J=  1  .M 
P(  J.  I  )=P( J.  I  )»1 .E-20 
Gn  TH  20 
CUNT INUE 
(-1  =  0. 

DS)     30     J=l.f' 
H(  J  )=P( J .NVt 1  ) 
R=MAX 1F( H, AHSF (H{ J ) ) 


SCALE     DHHh 


MECESSAR" 
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IF     (K-l.E*ie>      33.33.31 

31 

Dii     32     jrl.^* 

22 

0(  J)=B( J)«  l.E-22 

ITS=ITS*1 

ABZ2=X«»2*Y»»2 

^i;=MAxiF(AfiZ2,i.e-e«CAP) 

G1=F3(  1  )»«2*a(4)»«2 
G^-e( ?  )«»2+G(5)»»2 
G3=D(3)««2*B(C)»»2 
IF(PR)332. 21. 3i2 

222 

WKire     0UTPLT     TAPE     6.g6.X, 

c 

c 

FIND     Tt-E     CKNTl-flBLr  I0KS     01 

J4 

01 1=0. 

02^=0. 
02I=C. 

EIG5  -  EIGENVALUES  BF  REAL  KATfilCES  -  FBRTBAN  II  CeCEC 


EIG52190 
EIG52200 
EIC52210 
EIG52220 
EIG52230 
EIG52240 
EIG52250 
EIG52260 
EIG52270 
EIGb22eO 
^.Gl  .G2.G3.I e  EIG52290 

EIG523C0 
.G2  IK  S1,S2  KF  THE  CeMPcTEO  EIGENVALUES  EIG52310 

EIG'j2320 
EIG52330 
EIG5234C 
EIG5235C 
EIG52360 

VMuAR^C.  EIG52370 

IKNUO-NU)'i0.25.  25  EIG52380 

on     38  J=NL.M.C  EIG5239C 

EIG52400 
EIG52A10 
EIG52020 
EIGb2'>30 
EI GS2A40 
FI C52450 
EIGb2'»6C 
EIG52A70 
EIG52«80 
EICb2490 
EIGb2500 
EIG52510 
EIGb2S20 
EI G52530 
EIG5254C 
EIC52550 
-E  LKGAR  I  TH^*IC  DERIVATIVES  fF  THE  PBLYNewiAL         EIGS2560 

EIC52E70 
EIG525eC 
EIGS2590 
EIG52e00 
EIG52eiO 
EIG52620 
EIG52630 
EIG52e40 
EIGS2e50 
FIG52660 
EIG52C70 
EI G52CeO 
EIG52690 
EIGb2700 
EIGb2710 
EIGS2720 
LACUERFJE'S  F(^R^'LLA  EIG52730 


D,^  = 

nR( J )-X 

DI  = 

ni( j)-Y 

C2-- 

CR»«2+DI«» 

2 

IF(C2-l.E-l'i» 

ZZ)3 

yui 

AR=  1  . 

G0 

TS!     41 

OR: 

CiJ/r,2 

01  = 

-CI/D2 

Oil 

=01RtD« 

01 

=  01  I*CI 

Q2H  =  02I7  +  DR««2 

-0I« 

G2 

=021+2. "OR 

•01 

IF( 

G  i-cyz/*  1 

.e-i 

IFlYJt'l.^a.^O 

Tir<  =  f3(2  )/M(  1  ) 

Tl  1=0. 

T2n  =  R(  3)/LM  1  ) 

T2I=0. 

GW     T0     -ib 

TlW=(rj(2)i«B(  1 

♦  B(5)«B(4)  )/Gl 

Tl l=(U(5)»e( J 

-H(2  )»e( 4  )  ) /Gl 

T2I<=(H(  3)«R(  1 

♦H(e)»R(4) )/GI 

T2l=(H(t )«R( 1 

-B{^)^B^<^))/0^ 

sii<=  r  1W40  1K 

SI  I  =  T1  ltd  I 

Si'.n^T  IW««2-T  I 

••2-T2R-02R 

S2I=2.«T 1H»T 1 

-T2I-Q2I 

FIND     THE     NEXT 

ITERATE     USING 
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MAHK=2 

It 

G=NV-NUQ 

<*7 

IF(G-2. )£3.53t4e 

'\e 

IF(  IT5-1  )5l.El  .A? 

^q 

IF( Y-AeSF(CELX)-ABSF(OeLY)  )£l  .5  1 

.50 

50 

SI I=S1 r*.£/Y 

S2K=S2H*.2£/Y«»2 

G=G-l. 

£1 

IF(  SL1»*)53  .53  .52 

t2 

H=.£»(G-2.  ) 
G0     Ta     54 

e3 

H=G-l. 

ft 

0R  =  »-«(G»S2R-SIW»»2»SII«*2) 
DI=l-«(G»£2t-2.»SlK»SlI  ) 
IF(C1 )£C.5£.5e 

£5 

T  =  SQnTF(  ABSF(CI-I)  ) 

S  =  MAX1F(0.  .SICNF(  1..DIO  ) 

eH=T»S 

ei=T»( i.-s) 

G0     T0     57 

tt 

CALL     CXSGRKDR.Dt  .ER.fZI  ) 

£7 

IF(Sin»eR+Sl I •E I ) 56. 59. 59 

se 

ER=-E^ 
cI=-EI 

£9 

0H=S1R*ER 

C1=S1  I+E  I 

02=CR»»2+DI»*2 

0ELX=-G«0H/02 

X=X*ORLX 

0ELY=G«DI/C2 

Y=Y+CELY 

delnf;*=delx»«2+dely»»2 

AaZ2=X««2*Y«»2 
ZZ=MAXlF(AH/2.1.e-6»CAP) 
IF(  I  TS--*  )  70,65.60 

ec 

IFlCELNc*-  l.E-l?«ZZ)70.70.ei 

c 

c 

TtST     FUR     A     CYCLE 

c 

1 1 

IF(  («5LOl-:LX+DELX)«»2t(HLOELY  +  OELY 

)  ••; 

£2 

IFtSL0»)63.63.65 

t3 

iF(eNCE)e4.e<».65 

f* 

0NCE=l. 

DEL0LC=SZ«FLHATF(NV-NU) 

^HLC=SZ 

GH     ri«     7 

TtbT     F0R    LINEAR    CBNVERGENCE 

RHF.w=DELNE»/OEL0LD 

IF(RNE».-.6»RHL  0)70.66. 66 

MAkK=3 

IF(SL0» )e7 .6 7 ,69 

IF(G-3. )71 . 71,68 


EIG527AC 
EIG52750 
EIG52760 
EIG52770 
EIG52780 
EIG527gO 
EIG52e00 
EIG52e 10 
EIG52e20 
EIG52£30 
eiG52e*C 
ElG52e50 
EI G52e60 
EIG52e70 
EIG02e80 
EIG52e90 
EIG52900 
EIG5291C 
EIG52920 
EIG52930 
EIG529AC 
EIG52950 
EIG52960 
EIG52970 
EIG52980 
EIG5299C 
EI G63000 
E I G53010 
EI G53020 
EIG53030 
EIGt.304C 
EIG53050 
EIG53060 
FIG53070 
EIGb3080 
EI G53090 
EIGb3100 
EIG531 10 
EIG53120 
EIG53130 
EIG531AC 
FIG53150 
EI G53160 
EIG53170 
EI G53ie0 
EIG53190 
EIGb3200 
EIG53210 
EIG53220 
EIG53230 
EIG532AC 
EIG53250 
EIG53260 
EIG53270 
EIG532eO 
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ee 

x=x-oeLx 

Y=Y-CELY 

SL0V<  =  1. 

C0     T0     07 

eg 

SL«M=0. 

G4>     T«     71 

TEST     F0R     AN     EIGENVALLE 

70 

IF(CeLNevi-l.E-7«ZZ)73.73 

7  1 

0NCE=O. 

72 

OEL0LD  =  OFLNei. 

R0LC=RNew 

0LCeLX=CELX 

0LDeLY=DELY 

IF(  ITS-15)  11,  1*.77 

IF( Y)74.77.74 

74      IF(C2»Y»»2-G1 )75.77, 

•  77 

7e     IF( 0NCF ) 7£ .76 . 77 

7t     0NCE=1. 

Y  =  0. 

G0     Ta     72 

eiGENVALtlES  BF  REAL  fATBICES  -  FBBTBAN  II  CECEC 

EIG53290 
EIG53300 
EIG52310 
EIG53320 
eiG52330 
EIG5334C 
EIG52350 
EIG53360 
EIG53370 
EIG533aO 
EIG53390 
EIGS3400 
EIGS3410 
EIGS3420 
EIGb3430 
EIG53440 
EIGb3450 
CHMPLEX  APPRBACH  T0  A  REAL  ZERB  EIG53460 

EIG53470 
EIG534aO 
El  G534'30 
E1G53500 
EIG53S10 
EIG53520 
EIG53S30 
EIG53S4C 
EIG53550 
[•Y  AS  AN  EIGENVALUE  EIG53560 

EIG53570 

EIG5358C 

.E- 12«CAP )7e. 79. 79  EIG53590 

EIG53eOO 

EIG53C10 

EIG53e20 

)-l .t-6«ABSF(X) )e0.8C.8l  EIG5  36  30 

eO  Y=0  EIG53640 

ei   IF(NU0-NO)e3.e3.e2  EIG53e50 

£2  IF(RI(NOC-l  )  )e3. 63,84  EIG53660 

tj  Y=ARSF(Y)  EIG53670 

C0  T0  85  EIG536aO 

>4    IF  (  (X-RH(N(jC-1  )  )»«2<-(  ABSF  (Y)-fil  (^LC-l  )  )««2-l  .E-3«ZZ)  a45.e45,e2   eiG53e90 

Me  HH(MJO-I)=X  EIG53700 

Y=-AnSF(Y)  EIG5371C 

Rl  (NUO-l  )=-Y  E1G53720 

te  RI(NUG)=Y  EIGb3730 

iF(PR)e6.e7,ee  eig5374c 

£6  WRITE  HOTPLT  TAPE  6  .  1  .  RR  (  NLG)  .  R  I  (  NL  C  )  .  I  TS  .  ^  A  RK  EIGt)3750 

£7  ITS=0  EIGb3760 

RNei»  =  2.  EIG53770 

CAP=yAXlF< ABZ2.CAP )  eiG537eO 

EGSl,Ml=EGSl,MI*X  eiG53790 

EGSl,M2=eGSLM2  +  X»«2-Y»»2  EIG53B00 

IF(NLO-Wf)  8e.?5.95  EIG53aiO 

ee  IF  (Y)  90.91.69  EIGb3H20 

69  Y=-Y  EIG53830 
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77 

NU(;  =  NUQ  + 

IF(ABZ2- 

78 

X  =  0 

Y  =  0 

79 

RRCNUO  )  = 

IF(AaSF( 

HICENVALUES     0F     REAL     ►'ATPICES     -    F0RTRAN     II     CeCEC 


IF ( VNEA 
I  F  (  (  0  1  D 

ca-s{  3  > 
ci=a(e ) 

Di=Cfi»» 
IF(C2  )7 
X=X-2.« 
Y=AaSF( 
IF( X«»2 
CALL  FP 
RE  TURN 
FIOKVAK 
FflRVATC 
FtJwr'AK 
IPA.^T  19X 
ENC 

E  IG5 
SueNHUT 
F  =  M  A  X  IF 
F  =  F»SCjr! 
I  F  (  A  )  1  . 
Y  =  i,QRTF 


STEP  FR0M 


00-3)7,7.92 

R)  525,925.7 

••2+Ql  I««2 )»Z2-l.E  +  e)' 

+  2.«(H(2)»CJ1R-B(5)  «C1 

+2.»(e(2)»Ql I*B(5)«C1I 

2+C  1««2 

.7.54 

(CR«B(2)tCI«Q(5) )/C2 

Y-i .»(DR»8(E )-0I»a(2) 

+Y»«2-4.»CAP) 14,14,7 

ULC 


■■E  NEXT  Reer 


llt-0EIGENVALLE12X,2E2 
aHCITERATE20X,E15.e.5 
1F050X. 19HLAeLERRE  IT 
,  4(-P««2,  10X,£HP'»»2.1 


.Eis.e.e 


ERATl 

0>  ,6h 


^REAL  F 
khgvFL ) 


0NS.TES 
ARTIOX, 


I   11//) 
lot-  IMAG, 


CXSQRT  PART 


INE  CXSQRTCA.e, 
( AHSFt A ) , AQSF (H 
TF(  (A/F  )««2<-(B/ 


GH  rn  3 
X=SGRTF( (F^ 


EIG5384C 
EIGb3850 
EIG53a60 
eiGtj3e70 
EIG538eO 
EIG53a90 
EIG53500 
EIG53S10 
EIG53520 
EIG53530 
EIG5354C 
EI G53550 
EIG53960 
EIGb3570 
eiG53580 
EIG5359C 
EIG54C00 
EIGb4C10 
EIGb4C20 
EIG54C30 
EIG5404C 
EIG54C50 
EI Gb4C60 
eiG54Ce5 
EIG54C70 
eiG54C80 
EIG54C90 
EI G54100 
EI G541 10 
EI G54120 
E1G54130 
EIG5414C 
EIGE4150 
EIG54160 
EIG54170 
EIG54180 
EI Gt4190 
EIG54200 


li-if.tiliW^a.tV-'n;  KTQH    -   Eigenvalues  of  Complex  Matrices 

FORTRAN  II  Coded  -  7O9O 

I'ui'P'.hh;      Ti'    I'll II I   M    (j;  II)    "I'   tfie   eigenvalues   of  a  given 
noinijlhx-  II   X  11  rrialr-lx  for  2  _<  N  _<  70 . 

Mnl.liial;        KHiJutie  A    l-o  llessenberg    (almost   triangular) 

r'<>i'[ii  II   by   elementary   similarity   transforraatlons . 
'I'lie   ohai'acterlstlc  polynomial,    (Jet    (11-zI),   and 
Its   derivatives  are   evaluated  by  an   extension  of 
llyiiutii's   laetliod.      Mach   eigenvalue   of  11    (and   so 
nf  A)    Is    rnunil   Iteratlvely  using  a  modification 
Lit'  brtgiiHi're  'h   metlmd  . 

In])Ut{  '['Ills   Hulii'uutlne  assumes    that  A   Is   stored   In  core 

iiiniii.ii-y.      liHoause  FORTRAN   II   does   not   allow 
vai'l.ttt)le   DI1VIEN»'H0N  statements   In   subroutines 
the   rlVirimis  1 1'tis   of  A   and   the  vector   of  eigenvalues 
In    11  iH  iiui. Ill  i>i'iitj:ram  iiiust  be 

L      1  )JMKm I0N      A  ( 70 ,  70 )  ,    RT  ( 70 ) 
LI'  dli'i'ni'tMit    tllint)nslons   are  required   tlion   the 
.niMKN;iIi/^N  sttitomant  must  be   changed  accordingly 
In  FIQ-'I  and   Its   subroutines  CXTOI   and  CXLAG . 
Ni'    fur  thai'  changes  are  necessary. 

out^'ut:;        The  condition  of  each  eigenvalue  can  be   Judged 

from  the  successive  Iterates.      If  tlils   Information 
iH  not  wanted   It   Is  up   to  the  user  to  remove  the 
mVVK  0UTPUT  TAPE   statements    from  tlie   symbolic 
deck.      The    following  will  be  written  on  output 
tape  S   for  printing: 
'h'aoe  of  A 
'l-race  of  H 
.'UACceaalve  Iterates  and   the  values   of 

|pL   Ip'I.   |v"I 

Klgenval\ies  ai\cl  test  passed 
8um  of  Kigenvalues 
Here-  ?{z)   -  det    (H-al),   ^z  =   change   in  =, 
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|zl  =  absf  (Re  z)  +  absf  (Im  z) , 
L  =    [largest  eigenvalue  found  so  f ar | . 
Test  1   |P(z) I  <  10"^  |z|  |P'(z) I 

Test  2   |Az|   <   10"^  max  (|z|,  10"^  L) 

Test  :5   |Az1   <   10"^  max  (|z|,  10"^  L), 
(for  multiple  roots) 
l6  iterations  =  failure  to  converge 
Usage:     M  eigenvalues  of  the  N  x  N  complex  matrix  A 
will  be  stored  in  the  vector  RT.   Z  is  a 
starting  value  for  the  iteration  for  the  first 
eigenvalue.   If  all  eigenvalues  are  required 
it  is  preferable  to  find  them  in  approximately 
decreasing  order  of  absolute  values.   The 
code  itself  will  provide  a  good  guess  at  the 
eigenvalue  of  largest  modulus  if  Re  (z)  >  10-^-^. 
However  as  the  code  is  written  the  argument  Z 
will  be  changed  during  the  execution  of  EIG4, 
even  if  it  is  a  constant.   Hence  Z  should  be 
declared  as  a  complex  variable  and  typical 
entries  are 

I   Z  =  START 

CALL  EIG4(A,N,M,RT,Z) 
or 

I    Z  -  (l.E  +  56,  0.) 

CALL  EIG4(A,N,M,RT,Z) . 

Accuracy:  This  depends  on  the  proximity  of  the  eigenvalues 
and  on  their  condition.   All  eigenvalues  of  a 
10  X  10  matrix  were  found  with  errors  of  less 
than  10  in  the  last  (8th)  decimal  place. 

Time:      To  find  all  eigenvalues  of  random  complex  matrices 
of  order  10,20,30,40,50  took  .07,  .45,  I.27,  2.88, 
5.45  minutes  respectively.   This  Indicates  approxi- 
mately 150  N-^  operations  of  20  microseconds  each. 
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Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
ISQRT 

The  routine  also  uses  a  subroutine  PPT  to  handle 
overflow  conditions  and  the  subroutines  necessary 
to  write  an  output  tape.   These  routines  are 
discussed  more  fully  In  the  last  section  of 
this  report. 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  FL0AT,  MAXl,  MINO^  XMINO,  XM0D 

c)  Storage 

5587. Q  =  70030  locations  plus  the  required 
subroutines  listed  In  a) . 
Author:    B.  N.  Parlett 
Date:     April  I963,  Revised  June  I963 
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IG4   NYL  MATH  UTILITY    12/01/63   EIGENVALUES  0F  C0MPLEX  MATRICES  EIG40010 

SU8R0UTINE  EIG4(A.N,M,RT.2)  EIG40020 

DIMENSI0N  A<7C.70).RT(70) .Z( 1 ) .TRACE< I ).X(1) .E( I)  EIG40030 

CIMENSI0N  INT<70>  EIGA0040 

TRACE=A{1.1)  EIG40050 

00  JO  1=2. N  EIG40060 

0  TRACE=TRACE+A( I. I )  eiG40070 
WRITE  0UTPLT  TAPE  6 . 5 . TRACE . TR ACE ( 2 )  EIG40080 
CALL  CXTRI (A,1.E-8.N,INT)  EIG40090 
TRACE=A(1.1)  EIG40100 
D0  1  1   I=2.N  EI G401 10 

1  TRACE=TRACe+A( I, I )  E1G40120 
WRITE  0UTPUT  TAPE  6 . 6 . TR ACE . TR ACE ( 2 )  EIG40130 
NU=0  EIG4014C 
NV=0  EIG40150 

3     IF(NV-N) 14. 12. 14  EIG40160 


14 


E  =  HT(t 


EIG40170 
eiG40180 


NU  =  N  V 

16  IF(  INT(NV)  )15.  17.15  EIG40190 
15     NV=NV+1  EIG40200 

G0  T0  16  EIG40210 

17  IF(NV-NU)iq. 18.19  EIG40220 
lie  RT( NU)=A(NL.NU )  EIG40230 
I       X=RTtNU)  EIG4024C 

WRITE  0UTPLT  TAPE  e.7,X.X(2)  EIG40250 

G0  T0  13  EIG4C260 

19  IF(NV-NU-1  )20.21 .20                                                    .  EIG40270 

20  NP  =  XMIN0F(^'.NV)  EIG40280 
CALL  CXLAG (A. 1 .E-4,NP,NU.NV,RT.2)  EIG40290 
G0  T0  13  EIG40300 

121     R=( .5, .0)«<A<NU,NU)+A(NV.NV) )  EIG40310 

I       E  =  R»»2-A(NL.NU  )»A(NV.NV)tA(NL.NV)«A(NV,NU)  EIG40320 

I       S=SORTF(E)                                                        ■  EIG40330 

I       RT(NU)=RtS  EIG40340 

I       RT(NV)=R-S  EIG40350 

1       X=RT(NO)  eiG40360 


EIG40370 


WRITE  0UTPLT  TAPE  6 . 7 . X , X ( 2 )  .E  .E ( 2  )  EIG403eO 

G0  T0   13  EIG40390 

112     X=(.0..0)  EIG40400 

00  24  J=1.M  EIG40410 

124     X=X+RT(J)  EIG40420 

WRITE  0UTPUT  TAPE  6.e,X.X(2)  EIG40430 

RETURN  EIG40440 

5  F0RMAT( 1H030X.23HTRACE  0F  GIVEN  MATRIX  =E 16.8 . 1 H , E 16 . 8 )  EIG40450 

6  F0RMAT< 1HC27X,26HTRACE  0F  HESSENBEHG  FBRM  =E 1 6 . 8 , 1 H. E 16 . 8 )  EIG40460 

7  F0RMAT( { 1 IhOEIGENVALUE  12X,2E20.8))  EIG40470 

8  F0RMAT( 1H033X. 20HSUM  0F  EIGENVALUES  =E 1 6 . 8 . 1 H . E 1 6. 8 )  EIG404eC 
END  EIG40490 
SUeR0UTIKE  CXTRI (A. EPS. N, INT )  EIG40500 

1       DIMENSI0N  A{ 7C.70) ,C( 1 )  EIG40510 

OIMENSI0N  INT(70)  EIG40S20 

N1=N-1  EIG40530 

N2=N-2  EIG40540 
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118 
le  1 


00  2  1 
J  1  =  J  < 
J2  =  J< 
L  =  Jl 

NJl  =  ^ 


N-Jl 

J.  Jl) 

SF(C)*AeSF(C<2)) 

Jl ) 15. 15.C 

2  K=J2.N 

J.K) 

SF(C  )+ABSF  (C( 2  )  ) 

-5)12.12.11 


IF(N 
C0  1 
C  =  A( 

T  =  Ae 

IF(T- 
L=K 
S=T 
C0NTI 

IF(L- 


C=A(K. J* 1 > 

A(K, J*  1  )=A (K.L  ) 

A(K,L  )=C 

00   Ml   K=1.N 

C  =  A{  J+l.K  ) 

A(  J+  1  .K  )=A  (L.K  ) 

A(L.K  )=C 

R  =  0. 

00  151  K=l . J 

C=A( J.K ) 

T  =  AeSF(C  )*ABSF (Ct2  )  ) 

H=MAX1F(R,T  ) 

IF(S-EPS»W ) le. 16. 1 7 

L  =  0 

NJ  1  =  0 

G0  T0  lai 

C=A( J, J+1 ) 

00   18  KrJi.N 

A(  J.K)=A(  J.K  )/C 

00  20  1=1. N 

M  =  M1N0F(  J.  1-2  ) 

b=(O..C.  ) 

IF(NJ1  )  ig.  19. 7 

00  e  K=J2.N 


1 )«A( J, 


1  ) 


IF(M )20.20.q 
00  10  K=l  , V 
|J=0-A(K.  I  )  »A(  J< 
A(J+l.I)=A(Jtl,I)+L 
INT(J)=L 
INT(N)=0 
RtTtRN 

END 
SUBRBUTINE  CXLAG(A,EPS.N1  .NL.K.RT.Z) 

C1MENSI0N  A(7C.70).P(3.71).RT(70).Sl(l).S2(l).R(l).Z(l>.Bl<i: 
1).0J(1),E(1).DELZ{1).F1(1).S(1).G1(1) 
•.RITE  0LTPLT  TAPE  6.1 
BL  1  =  1  . 


EIGAC550 
EIG40560 
eiG40570 
EIG40580 
EIG40590 
EIG40600 
EI GA0610 
ei G40620 
EIG4C630 
FIGA06«0 
EIG40650 
EIG40e60 
El G40670 
EIG40680 
EIG40e90 
EI G40700 
EIG40710 
EIG40720 
EIG40730 
EIG4074C 
EIG40750 
EIG40760 
eiG40770 
EI G40780 
EIG40790 
EIG40800 
eiG40810 
EIG40820 
EIG40830 
EIG40840 
EIG40850 
EIG40860 
EI G40870 
EIG40e80 
EIG40890 
EIG409C0 
EI G40910 
EIG40920 
EIG40930 
EIG4094C 
EIG40950 
EIG40q60 
EI G40970 
EI G40980 
EIG40990 
EIG41000 
EIG41010 
EIG4 1C20 
EIG4 1C30 
EIG41040 
EIG41050 
1EIG4 1C60 
EIG4 1C70 
E1G4 1080 
E I G41C90 
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NUO=NU-I  Ciowiiuu 

LLY=0  EIG41I10 

CEL0LC=1.  EIG41120 

R0LC=l.  EIG4I130 

SUM1=0.  EIG41I40 

SUM2=0.  EIG411S0 

CALL  FPTEST(X)  EIG4I160 

I       P(  1  ,NU  )  =  (  1  ..  .0  )  EIG4I170 

I       P( a.NL )  =  (  .0,  .0  )  EIG41180 

I       P(  3,NU  )  =  (  .0,  .0  )  EIG41I90 

NU1=NU+1  EIG4I200 

CUP=0.  EIG41210 

OH  11  J=NU1.N  EIG41220 

I       R=A(J-l.J)  EIG41230 

11     CUP  =  CUP  +  ABSF(R  )+ABSF (R (2)  )  EIG41240 

CUP=CLP/FL0ATF{N-NL)  EIG41250 

CAP=0.  EIG41260 

C  EIG41270 

C       FIND  THE  TRACE  0F  A  AND  A»»2  EIG412eO 

C  EIG412'30 

SPUR  1  =  A(  NL.NLi  )  EIG41300 

SPUR2=SPUR 1»«2  EIG41310 

00  13  J=NU1.N  EIG41320 

T=A(J.J)  EIG41330 

SPUR 1=SPUR 1+T  EIG41340 

SPUR2=SPUR2+T«»2+(2..0.)»A(J-l,J)«A(J,J-l)  EI G4 1350 

S1=-SPUR1  EIG41360 

S2=SPUn2  eiG41370 

C  EIG4I380 

C       INITIAL   ITERATE  (EITHER  GIVEN  0R  FRBM  INFINITY)  EIG41390 

C  EIG41400 

131    IF( Z-1 .E  +  3S  )23.14, 14  EIG4I410 

1^     F1=N-NU0  EIG41420 

IF(ABSF(S1)+A0SF(S1(2))+ABSF<S2)*ABSF(S2(2))-1.E-6«CAP)15.15.16     EIG41430 

15     Z=CUP  EIG41440 

G0  T0  23  EIG41450 

116     0=(Fl-( 1 ..0. ) )»(F1»S2-Sl«»2)  EIG41460 

1       Z=(SQRTF(C )-Sl )/Fl  EIG41470 

C  EIG414eO 

C       EVALUATE  P0LYN0MIAL  AND  DERIVATIVES  EIG41490 

C  E1G41500 

23  Pll.NU)=1.0  EIG41510 
IF  (LLY+NUQ-NU)  24,24.235  EIG41520 

24  P{  I  .NU)  =  l.E-20  EIG41530 
23?    D0  33  K=NU,N  EIG4I540 

EIG41550 
EIG4 1560 
EIG41570 
EIG41580 
EIG41590 
EIG41600 
EIG4 1610 
EIG41620 
EIG41630 
EI G4 1640 


T=-A(K.KtI  ) 

C0     33    L=1.2 

S=FL0ATF(xy0OF(L-l 

3)  ) 

R=-(Z»P(L.K)+S«P(L- 

-1 .K  )  ) 

C0     28     J=NU,K 

R  =  H+P(L, J  )«A(K  ,  J) 

IF(X)2g,34.2g 

x  =  o 

P( I.NU)=P( l.NU)»l.E-15 

IF(P(  1 .NU)  )30. 30.2 

35 

-  226 


10 

F=.S«FL0ATF(K-NU)/FL0ATF(N- 

-NUtl 

*RITE  0CTPLT  TAPE  6.4.Z(1) 

.2(2) 

I 

Z  =  f*Z 

I 

P( l.NU)=« I ..0. ) 

G0  T0  235 

34 

IF  (N-K)  31i31.32 

131 

P(LtK+ 1 )=R 
G0  T0  33 

132 

P(L,K+l)=R/T 

33 

C0NTINl;e 

C 
C 

SCALE  D0*N  THESE  VALLES  IF 

RECL 

c 

135 

B1=P( 1 .N+1 ) 
e2=P<2.N+l ) 

EIGA  -  EIGENVALLES  0F  C0KPLEX  MATRICES  -  F0RTRAN  II  C0OEO 

EI Goieso 

EI G4 1C60 
EIO  1670 
EIG4 1680 
EIG4ie90 
EI G4  1700 
EIG41710 
EIG4 1720 
EIG4 1730 
EIG417A0 
EIG4 1750 

;d    t0   Aveio    0verfl0i«i  eiG41760 

EI G4 1770 
EI  04 17  80 
EIG41790 

I       B3=P(3,N+1 )  EIG4 1800 

Gl=AeSF(Bl )+ABSF(Bl(2) )  EIG41810 

G2=AeSF(B2 )+ABSF(B2( 2) )  EIG41820 

63=ABSF(H3 )+ABSF(B3(2) >  EIG41830 

S=MAX1F{G1 .G2 )  EIG4184C 

S=MAX1F( S.C3 )  FIG4ie50 

IF( S-l. £+15)43.43. 36  EIG4ie60 

136     Bl=Bl/(  1  .e  +  15.C. )  EIG41870 

I       B2  =  e2/(  1  .E  + IS.O.  )  EIG41680 

WRITE  0UTPLT  TAPE  6 . 2 , Z (  I  )  .  Z ( 2 )  , G I .G2 . G3  EIG41890 

I       B3=e3/( 1 .E+iq.O. )  EIG4I900 

C  E IG4 19  10 

C       REM0VE  EFFECT  0F  KN0*N  R0eTS  FR0M  S1.S2  THE  L0G  DERIVATIVfcS  EIG41920 

C  EI G4 1930 

143  Q1=(.0..0)  EIG41940 
I       Q2={.0..0)  EIG41950 

IF(NUO-Nt  )  19.2 1 .21  EIG41960 

21     D0  44  J=NU.NtQ  EIG41970 

I       D=( 1 . .0. )/ (RT( J>-Z )  EIG41980 

I       Q1=G1+D  .                                EIG41990 

144  Q2=Q2+C»»2  EIG42000 
IF  (Gl )  41 .41 . 19  EIG42010 

119     S1=01+B2/B1  EIG42020 

I       S2  =  <B2/Dl)»»2  -  B3/B1  -  02  EIG42030 

C  EIG42040 

C       FIND  NEXT   ITERATE  EIG42050 

C  EIG42060 

LLY=LLY*1  E1G42070 

IF(l.E+7-Z2»(ABSF(SI)+ABSF(Sl(2))))41,4I,42  EIG42080 

41     MARK=1  EIG42090 

EI G42100 
E1G421 10 
EI G42120 
EIC42130 
6  IG4214C 
EIG421S0 
EI G42I60 
EI G421 70 
EIG42180 
E I G42190 
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&0  T0  100 

42 

G=N-NUQ 

50 

IFIBLl  )e5. 65.66 

65 

H=.£«(G-2. ) 

G0  T0  67 

66 

H=C-1. 

67 

D=F»(G»S2-Sl»»2) 

E=SGRTF(C) 

IF(S1»E+S1(2)«E(2))55.56.56 

EIG4  -  EIGENVALteS  0F  CBVPLEX  f'ATRICES  -  F0RTRAN  II  C0OEC 

156    0EL2=-G/(Sl*e )  £1042200 

I       Z=Z+DEL2  EIG42210 

DELNE*=ABSF(CELZ)+A8SF(DEL2(2) >  EIG4  2220 

RNE*«  =  CELNEI«/CEL0LD  EIG42230 

ZZ=ABSF(Z )+ABSF(Z( 2) )  EIG42240 

C  EIG42250 

C       TEST  F0R  CYCLING  AT  57  AND  F0B  LINEAR  C0NVERGENCe  AT  571              EIG42260 

C  EIG42270 

IF(LLY-3)e2.€2.57  EIG42280 

57  IF(CELNe*-VAXlF( 3.«DEL0LD..5«2Z) )S7l .571 ,570  EIG42290 
57C  IF(BL1 )571 .571 .572  EIG42300 
572   DELaLD=CAPt 1 .0  eiG423l0 

R0LC=3.  EIG42320 

IF(LLY- 15  )  14,  14.  100  EIG42330 

571    IF(RNEV»-.7»R0LD)e2.5e,58  EIG42340 

58  MARK=3  EIG42350 
IF(CELNE»(-.1«EPS«MAXIF(ZZ..01«CAP)  )  70.59,59  EIG42360 

59  IF(BL1  )e  1  .e  1  .eC  eiG42370 
160     Z=2-DELZ  EIG423e0 

BL1=0.  eiG42390 

G0  T0  50  EIG42400 

61  eLl=l.  EIG42410 
G0  T0  63  EIG42420 

C  EIG42430 

C       TEST  F0R  AN  EIGENVALUE  EIG4244C 

C  EIG42450 

62  IF(CELNEvii- 10. •EPS•^  AXlFt  ZZ.. OCI»CAP,  )64, 64, 63  EIG42460 

63  DEL0LC=CELNE*  EIG42470 
R0LC=RNe»  EIG424eO 
1F(LLY-15)23.23. 100  E1G42490 

64  MARK=2  EIG42500 
70     8Ll=l.  EIG42510 

C  eiG42520 

C       WE  ACCEPT  Z  AS  A  R00T  EIG42530 

C  EIG42540 

IOC   NUQ=NUG+1  EIG42550 

I       RT{NUG)=2  EIG42560 

WRITE  0UTPLT  TAPE  6 , 3 . Z . Z ( 2 ) . LL Y , V ARK  EIG42570 

LLY=0  eiG42580 

CAP=MAX1F ( ZZ .CAP)  EIG42S90 

OEL0LC=1.  EIG42600 

RHLC=1.  EIG42610 

I       SUMl=Sb^' 1+HT  (NUQ)  EIG42e20 

I       SUM2=SUM2+RT(NtO)»»2  61042630 

1       S1=SUM 1-SPLR 1  EIG4264C 

I       S2=SUM2-SPLR2  EIG42650 

IFtNUQ-N 1 )e4. 1 01 , 101  EIG42e60 

C  EIG42670 

C       A  NEWT0N  STEP  T0WARDS  NEXT  R0eT                                            EIG426eO 

C  EIG42690 

04     IF((ABSF(Q1)+ABSF(G1(2)))»VAX1FIZZ..001«CAP)-1.E*4)86,86,14  EIG42700 

186     Z=Z-B2/( ( .5. .0 )»B3-B2»Q1 )  EIG42710 

G0  T0  23  E1G42720 

101   CALL  FP0Lr;  EIG42730 

RETLRN  EIG42740 


228 


EIGENVALUES  0F  C0KPLEX  MATRICES  -  F0RTRAN  II  C0CEC 


I       FaWMAKl 

H050X.  IQHLAGLERRE  I TER AT  I KN S// 3  I  X . 9HRE AL 

PARTI 

lOX.lOH  IMAG 

,.EIG42750 

1PART22X. 

IHPl IX ,7HP  PR 

I^'E6X,I1^P  DEL  PRIME) 

EIG42760 

2      FHHWAT(e 

IH  ITEWATE20X. 

E15.8.5X.E15.e.8X.3El5.4) 

EIG42770 

J      FawyATC  1  It-OEIGENVALUE 

I2X.2E20.8.12X.I3.17H  ITERATI0NS, 

.TEST  11//) 

E I G427eO 

4      FURMAKfi 

IH  ITERATE20X. 

2E20.e.l2X.9l-  0VERFL0W) 

EIG42790 

END 

EIG42800 

INUHPT       NU  V 

ERSIBN  0F  FPT 

.    VERSIBN  2   MAY  1962.    HAS  ALTERNATE  ENTRI 

EEIG42810 

i        FAP 

EIG42e20 

PCC 

EIG42e30 

C«UNT 

tc 

EI  042840 

LEL 

NLFPT.9 

EIG42850 

ENTRY 

FPTEST 

EIG42e60 

fcNTRY 

FP0LC 

EIG42e70 

ENTRY 

(FPT  ) 

EIG42e80 

PTfcST  CLA 

e 

EI G42e90 

STB 

NEW4  1 

SAVE  L(8) 

EIG42900 

STZ 

0VFL0* 

CLEAR  77462 

EIGA29I0 

CLA 

1,4 

EIG42920 

STA 

NEw  +  2 

L(C0NTENTS  0F  L(0)) 

EIG42930 

CLA 

NE* 

L ( TTR, (FPT) ) 

EI G4294C 

STB 

8 

MLST  LSE  THIS  (FPT) 

EIG42950 

CLA 

NEw  +  2 

L(STI .»•) 

EIG42960 

ST« 

eRR0R+I 

N0CIFV(FPT)  Se  1 

EXEM 

EIG42970 

CLA 

NE*  +  3 

C0tS  N0T  ACT 

EIG42980 

ST0 

ERR0R+2 

EIO2990 

TTR 

2.« 

EIG43000 

(FFT)  STI 

IND 

SAVE  1KDICAT0RS. 

EIG43010 

LCI 

0 

EXAMINE  BITS   14-17   0F   LBC 

i;ER0 

EIG43020 

LFT 

4 

SKIP  IF  N0N«0VERFLe»   (BIT 

15) 

EIG43030 

TTR 

ERR0R 

(IN  FPT  ♦  3)  0VERFLew  AC 

0R  MQ 

EI G43040 

LFT 

2 

SKIP  IF  ACC  N0T  INVOLVED 

EIG43050 

CLM 

EIG43060 

LNT 

e 

SKIP  AND  C0MPLEMENT 

EIG43070 

C0M 

0NCE  BN  ACC  UNORFLew 

EIG43080 

C0M 

EIG43090 

XCA 

GET  MQ 

EI G43100 

LFT 

1 

SKIP  IF  N=  M(3  N0T  INV0LVEO 

EIG43I 10 

CLW 

EIG43120 

LNT 

5 

C0MPLEMEMT  KNCE  0N 

EIG43130 

C0M 

MQ  LNDERFLe» 

EI G4314C 

C0M 

EIG43150 

XCA 

RESTKRE  MO  AND  ACC 

EIG43I60 

LD  I 

IND 

REST0RE   INCICAT0RS. 

EIG43170 

tXlT   TTR* 

0 

EIG43180 

eftHfM     STI 

0\/FLUW 

77462 

EIG43190 

LDI 

•♦2 

EIG43200 

TTR 

t (EXE  ) 

EIG43210 

P^E 

7,4,«*1 

EIG43220 

LCI 

0VFL0* 

RETURN  FR0M  EXE  IF  NBT  IN 

M0NIT0R  M0Dg 

EIG43230 

TTR 

{ FPT  )  44 

EIG432A0 

Ne»     TTR 

(FPT  ) 

CBNSTANT 

EIG43250 

TTR 

(  FPT  ) 

SAVE  0RIGINAL  L(a)  HERE 

EI G43260 

STI 

•  • 

C0NSTANT-STA  0F 

VARIABLE  HERE 

EIG43270 

TTR 

ERR0R+4 

CeNST 

EIG43280 

LD  I 

ERR0R+3 

CBNST 

EIG43290 
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TTR 

t(Exe  ) 

CLA 

NE«*4 

ST0 

ERRBR+l 

CLA 

NEW  +  5 

STB 

ERR0R+2 

CLA 

NEM-f  1 

STB 

e 

BESTBRE  EXEK  AFFECT 


BESTBRE  L(8) 
CLEAR  7746? 


avFLBw  c^MM0^ 

END 


EIG43300 
EIGA3310 
EIG43320 
eiG43330 
EIG43340 
EIG43350 
eiG43360 
EIG43370 
EIG43380 
EIC43390 
EIG43400 
EIG43410 
EIG43420 
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Identification:     H0US1  -  Eigenvalues  and  Eigenvectors 

of  a  Real  Symmetric  Matrix 
7094  -  FORTRAN  II  Coded 
Purpose:   To  find  the  eigenvalues  and  eigenvectors  of  a 

real  symmetric  matrix. 
Method:    The  matrix  Is  reduced  to  trldlagonal  form  by 
Householder's  method  and  bisected  using  Sturm 
sequencing  to  determine  the  eigenvalues.   The 
eigenvectors  are  computed  using  Wilkinson's 
method.   See  three  articles  by  J.  H.  Wilkinson 
in  Numerlsche  Mathematlk  4,  354-376  (1962) 
for  a  more  complete  discussion  of  the  algorithms 
used  o 
Usage:    Entry 

CALL  H0USl(A,N,C,B,G0,aU,IT,Z,W,Ml,FN0RM) 
where 

A         is  the  matrix  to  be  solved  given  in 
lower  triangular  form.   The  Initial 
contents  of  A  are  destroyed  by  H0US1. 
N         is  the  order  of  matrix  A. 
C         is  a  vector  of  order  N  which  will 

contain  the  diagonal  elements  of  the 
trldlagonal  miatrix  upon  exit. 
B         is  a  vector  of  order  N  which  will  contain 

the  subdiagonal  elements  of  the  trldlagonal 
matrix  upon  exit  (B(N)=0). 
G0        is  the  upper  (lower)  bound  of  the 
eigenvalues  to  be  computed.   This 
argument  must  be  a  variable  and  not 
a  constant  since  its  value  will  be 
changed 
GU        is  the  lower  (upper)  bound  of  the 
eigenvalues  to  be  computed.   This 
argument  must  be  a  variable  and 
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not  a  constant  since  its  value 
will  be  changed . 
IT        is  the  number  of  bisection  steps  to 

be  used . 
Z         is  an  array  which  will  contain  the 

eigenvectors.   Z(I,J)  will  be  the  J-th 
component  of  the  eigenvector  corres- 
ponding to  ¥(I) . 
W         is  a  vector  of  order  Ml  which  will 
contain  the  eigenvalues  upon  exit. 
Ml        will  be  the  number  of  eigenvalues 

computed  by  H0US1. 
FN0RM     will  be  the  infinity  norm  of  the 

tridiagonal  matrix. 
The  routine  contains  internal  vectors   Q,FM,p,R, 
and  PINT,  the  size  of  which  must  be  at  least  N 
and  an  internal  vector  X  the  size  of  which  must 
be  at  least  N+2.   The  following  DIMENSION  state- 
ments appear  in  the  routine  as  compiled  and  may 
be  changed  by  the  user  if  necessary. 

DIMENSI0N  A (50, 50),  B(50),  C(50),  W(50),  Z( 50,50) 
DIMENSI0N  Q( 50 ) , FM ( 50 ) , P ( 50 ) ,R ( 50 ) , PINT( 5O ) ,X( 52 ) 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SQRT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS 

c)  Storage 

l660-,p|  =  ^'^^^p,   locations  including  the  internal 
vectors  plus  the  required  subroutines 
listed  in  a) . 
Time:      35  >  N  >  25   .006n^-  .012N  -  .2l(lT)  +  .012N(IT) ^^^ _ 

(approx.) 
N  >  35   .014N  -  .225N  -  .24(IT)  +  .012N(IT) 
Author:    Miriam  Shapiro   (translated  from  ALGOL  Procedures) 
Date:      April  1964 
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FBRTRAh   II  C0CEU 


CH0LSI  NYL  M«TH  UTILITY  /  I-0I2  /  V.  SHAPIRR 

C  EIGENVALUES  AND  EIGfcNVECTHRS  BF  T(-E  ^»ATRIX  A. 

SUHR»LT1NC  HHLSl(A,^,C.B.GelGUtIT,2,*,^'I.F^(!R^) 
DIMENSIBN  A(50.50),B(50),C(50).I«<£0).2(50.50) 
DIMCNGiaN  0(EC),FM(50).P(eO),R(50),FIM(50).X(52) 

tobivALtNCt  (ITl.Tn,(IQl,ol),(IPl,pn.(Iece^^,ece^ 

n       DCUN1=200000CCOOCC 
GA(i'MA=l.Cfc-ie 

EPb^'Ac  =  l  .OE-e 

I=N 
?C  IF  O-I  )  1  .  1  .2 
I  bIGVA=0 

KK=I-1 

C«   2  K= I .KK 
3  SlGMArS IC^A+A( I .K ) "A ( I ,K ) 

AI=A(  I  .  I-  1  ) 

IF{ AI  )E,t  ,t 
e  C I=-SURTF( EIGVA) 

GH  T0  7 
E  BI=SGRTF( S IG^A ) 
7  P( I- I )=BI 

IF (R I )e.9ie 
fc  h=S IGMA-Al »HI 

A(  I  .  I-  1  ) =A I-B  I 

J=  I-  1 


le 

IF ( 1-J ) 10, 

,  10, 

.  1  1 

IC 

HJ  =  C 
K=  I-  1 

i^ 

1F(  J-K  )  12, 

,  12, 

.  13 

12 

t'J=EJ*A(K, 

K=K-  I 

G0  TO  14 

,J)< 

•A( I ,K) 

13 

K  =  J-1 

17 

IF{ 1-K ) 15, 

,   15, 

.  16 

\t 

BJ=BJ+A( J, 

,K)»A( I .K> 

K=K-  1 

GM  T0   17 

le 
11 

0( J )=BJ/F 
J  =  J-  1 
G0  TB  le 
b!IGK  =  C 
J=  1-  1 

c   1 

I F  (  1  -  J  )  1  g  , 

,  19, 

,20 

19 

FiIGK=HIGK4A(  1 

1 , J )«Q( J ) 

J  =  J-1 

&0  IK  21 

rO 

HIGK=n IGK/( 2, 

,»H) 

J=I-1 

22 

1F(  1-J  )23, 

,23, 

,24 

;^3 

Q(  J  )=Q( J>- 

-R1GK»A( I . J> 

J  =  J-1 

GB  TM  22 

2A 

J=I-  1 

i5 

IF(  1-J)2e, 

,2t. 

,9 

2t 

K  =  J 

H0OS1CO 1 
H0US1CO2 
H0UblCO3 
H0LIS  ICOA 
H0LS 1CC5 

H0ubicoe 

H0U5 1C07 

H0usicoe 

H0US1OO9 
H0US1C IC 
H0US1C  1  I 
H0US1C 12 
H0US  IC 13 
H0LIS1C  lA 
H0US1C 15 

H0US  IC le 

H0US1C 1 7 

H0U51O le 

H0bblC 15 
H0US 1C20 
H0LS  102 1 
H0L;S  1C22 
H0US 1C23 
H0US1C2A 
H0US1O25 
h0OSlC2e 
H0US 1C27 

H0ubiC2e 

H0US1C29 
h0USlC3C 
H0US1C31 
H0US1C32 
H0US1C33 
H0US1C3A 
H0USlC3e 

H0usiC3e 

H0OS 1037 
H0US1C36 
H0US1C3S 
H0US1CAC 
H0US1O4 1 
h0USlCA2 
H0US1CA3 
H0US 10A4 
H0US1OA5 

H0usiC4e 

H0Ub 1CA7 

H0L/S  io<ie 

H0US 10A9 
H0LSIC5O 
H0US1C51 
H0US1CE2 
H0(jS1C53 
H0US1C5A 
H0US1C55 
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il    IF(  l-K  »2e.2e.2q 

so  A(J,K)=A{J,K)-A(I.J)«Q(K)-A(I.K)«C(J) 

C0  T0  27 
29  J=J-l 

G0  T0  25 
9  1=1-1 

G0  T0  30 
2  I=N 
21  1F( I-I )32. 32.23 

32  C(  I  )=A(  I  ,  I  ) 
1=1-  I 

G0  Ta     21 

33  B(  J  )=A(2.1  ) 
B(N)=C 
IF(Gtl-G0  )4C.40.41 

41  G=GO 
GU  =  C0 

Gi>  =  e 

40  FN0RM  =  AeSF(C(  1  )  )+ABSF(B(  1  )  ) 
Obt  42  1  =  2. N 

FL=AHSF(Q(  I-l  )  )*ABSF (C<I  )  )+ABSF(B(I  )  ) 
IF(FL-FN0Ry )4  2.42,4  3 

43  FN0RM=FL 

42  CBNTINLE 
I I=N-l 

00  44  1=1.11 
IF(e( I ) )4£ .4^.45 

46  P(  1  + 1  )  =GAyMA«FlM0RM»FN0RM 
G0  T0  44 

45  P(  I* 1  )=B(  1  )»0(  I  ) 

44  CBNTINue 
P(  I  )  =  0 
IF(CU-FN0RM)47.47,4e 

47  IF(C0+FN0RM)4e.4q,4q 

4e  wi=c 

G0  T0  £0 
49    FL4f'B  =  Glj 

ASSIGN  £1  T0  ISTEX 

G0  T0  64 
£1   1A2:IAI 

IFlOl )52.£3.52 


FL/ 


:  lA  l+l 
'8  =  G0 


,5£.56 


ASSIGN  £4  T0  ISTE) 

G0  T0  64 
£4  M1=IA2-IA1 

I0=IA1 

IF(G0-FN0l. 
£6  G0=FN0RM 

£5   IF(GL*FN0RM)£7.5e.5e 
£7  CU=-FNaRM 
£e  00  £9  K-\,Vl 

10=10*1 

G=G0 


H0OStC56 
HaUSlC57 
HBUSlOSe 
H0USlC5g 
H0US1C6O 

H0usicei 

H0US1O62 
H0US1C63 
H0US1C64 
H0USlCe5 

Housioec 

H0USlCe7 

H0usiC6e 

H0US1C69 
H0US1O7O 
H0US1C71 
H0US1O72 
H0US1C73 
M0US1O74 
H0US1O75 
H0USlC7e 
H0US1O77 
M0USlO7e 
H0USIO79 

H0usioeo 
H0usioei 

M0US1O82 
H0US1OE3 

H0usioe4 
H0usice5 
H0usioe6 

H0USlOe7 

H0usioee 

H0US1C89 
M0US1O9C 
H0U5IC9I 
H0US1C92 
H0US1C93 
H0US1O94 
H0US1C95 

H0i;siC9e 

H0US1C97 

H0US  i09e 

H0US1O99 
H0US1 100 
H0US 1 10 1 
H0USI 102 
H0US1 103 
H0US11O4 
H0US1 10£ 
H0US1 106 
H0US1 107 

H0US1 loe 

H0US1 109 
H0US1 1 10 
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H  =  GL 

D0   eC  J=l,IT 

FLAVB=(G+h)/2. 

ASSIGN  61  T0  ISTEX 

Ga  10  £4 


ei 

iF(  iAi-ic)e2.e3,e3 

t3 

H=FLAMe 
G0  T0  eo 

tz 

G=FLAMB 

to 

C0NTINLE 

eg 

W(K  )  =  (  G  +  t-  )/2. 

50 

G0  Ta  96 

e4 

P1=0. 
01  =  1. 
IA1  =  0 
00  65  1=1. N 

Y=(C{  I  )-FLAME  )»Q1-P(  1 

[  )«PI 

IF( Y )20e,207,206 

2ce 

T  l=Y«377CO0OOOOO0 

IT1=IBC0N1-IT1 

IF(GI)200.20';,201 

2C9 

P1=Q1 

G0  T0  202 

200 

IP1= IQl- ITl 
G0  T0  202 

2C1 

IP1=IQ1+IT1 

202 

IF( Y)2C3.204.204 

2C3 

IQ1=IY-IT1 
G0  T0  205 

204 

IU1=IY+ ITl 
G0  T0  205 

207 

P1  =  Q1 
Q1=Y 

2CS 

IF(Pl)e6.67.67 

ee 

IF{Ql)6e.65.e5 

te 

IA1=IA1+1 

G0  T0  65 

£7  iF(ai )e5.6e,ee 

65  C0NTINUe 

IF(01 )69,70.e9 

70  IF(P1 )69.69.71 

71  1A1=IA1-1 

69  G0  T0  ISTEX,  (51  .54.61  ) 
96  FLAVB=FN0nM 

EPS  =  EPSMAC«FN0,<M 

00     97     J= 1 .Ml 

FLAMB=FLAMe-eP5 

IF(i»(J)-FLAMB)98,99,99 
?«  FLAMB=H(J) 
99  U=C( 1 )-FLAMR 

V  =  B(  1  ) 

IF( V )  100.  ICl  .  100 
CI  V=EPS 


H0US1  11  1 
H0US1 1 12 
H0US1 113 
H0US1 1 14 
H0US1 1 15 
H0US1 1 16 
H0US1  1  17 
H0US1  1  le 
H0US1 1 19 
H0US1  120 
H0US1 121 
H0US1 122 
H0US 1 123 
H0US1 124 
H0US1125 
H0US 1 126 
H0US1 127 
H0US1 128 
H0US1 129 
H0US1 130 
H0US1 131 
H0US1 132 
H0US1 133 
H0US 1 134 
H0US1 135 
H0US 1 136 
H0US1 137 


lUSl 


138 


00  102  1=1 


I  I 


H0US 1 139 
H0US1  14C 
H0US1 141 
H0US1 142 
H0US 1143 
M0US1 144 
H0US1 145 
H0US1 146 
H0US 1147 
H0US I  146 
H0US1 149 
H0US1 150 
H0US1 151 
H0US1 152 
H0US1 153 
H0US1 154 
H0US 1 155 
H0US 1 156 
H0US1 157 
H0US1 158 
H0US1 159 
H0U5 1 160 
H0US1 16 1 
H0US1 162 
H0US 1 163 
H0US1 164 
H0US1 165 
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■0USI  -  e  IGEtMVALLES/VECT0RS  2F 


HEAL  SYVf/ETBlC  MATRI 


B1=B( I ) 

IF(e I ) 102, 104. 103 

BI=ePS 


1C5 


IC3  ei  1=H(  1+  1  ) 

IF(H 1 1  )  ic=.  ice 

ice  B I 1=EPS 

,  C5  IF(*BSF(BI)-ABSF(0))107, 

FM( I+l )=U/flI 

lF(Fy( 1+ 1 ) ) IC9. 1 10 , 1C9 

IK(ei-EPS ) 1 1 1 , 1 1 1 , IC? 

FM (  I  +  1  )  =  1  . 

P(  I )=e  I 

Q(  I  )=C(  I  +  l  )-FLAMa 

H(  I )=e 1 1 

U  =  V-FM(  I  +  l  )»C(  I  ) 
V  =  -FM(  1+  1  )»R(  I  ) 


1C« 
1  10 

1 1 1 

1C9 


Fll 


)  =  1. 


CH  T«   102 

FM( I+l )=MI/L 

PI  I  >=U 

0( I )=V 

R(  I  )=0 

0  =  C (I  +  l  )-FLAVe- 

-FM 

V  =  R  I  1 

F1NT( I+l )=-l 

CUNTINUE 

P(N)=0 

0(  N  )  =0 

KtN)=0. 

X(N+I )=0. 

X(N+2)=0. 

H  =  C. 

I=N 
112  IF<  1-  I  )  I  12  ,  1  13 
1  1  3    U  =  £  TA-C(  I  )»X(  I 

IF(P(  I  )  )  1  15.  1  H 
lit  X( I )=L/EPS 


G0 


1  7 
I  )=b/P(  I  ) 


»DSF( X(  I  )  ) 


h-=  1  ./H 

DM   lie   I  =  1  ,N 

X(  I  )=X(  I  MF 

De)   119   I  =2  .N 

IF(F  INT(  I  )  )  120.  1 

L=X(  I-  1  ) 

X(  I-l  )::x(  I  ) 

X(  I  )=U-Fy (  I  )»X(  I 

G0   T0   119 

X(  1  )=X(  I  )-FV(  I  )< 


H0US  1  lee 
H0USI  le? 

HaUb  1  166 
H0U51 169 
H0US1 170 
H0U51 171 
H0US1 172 
H0US1 173 
M0US1 17* 
H0US1 175 
H0US 1  17e 
H0US 1177 
H0US 1 178 
H0US1 179 
H0USI lec 

H0US  1  lei 

H0USI 182 
H0US1 163 

H0USI  leo 

H0US I  185 

H0US1  lee 

H0US1 167 
H0US 1 166 
H0US1 189 
H0US1 190 
H0US1 191 
H0Ubl 192 
H0US1 193 
H0US1 190 
H0US119E 

H0US  1  i9e 

H0US1197 
H0US1  196 
H0US1 199 
H0US12OO 
H0US12O1 
H0US12O2 
H0US12O3 
H0US12OA 
H0US12C5 
H0US 120e 
H0US12O7 
H0Ub 1 206 
H0US12O9 
H0US121O 
H0US121 1 
H0US1212 
H0US1213 
H0US12M 
H0US12I5 

H0usi2ie 

H0US 12 1 7 
H0US1216 
H0US1219 
H0US122O 
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/ALLeS/VECT«RS  BF  A  REAL  SYf'^'eTRIC  MATRIX  -  FeRTBAN   II  C0DEO 


I=N 
12'^     IK  1-1)123.123.121 
li2    U=XII)-0(I )«X(I+l)-R(l)»X(I+2> 

IF(P(  I  )  )  1£S.  126,  125 
\2t     X( I )=U/EPS 

G0  TH  127 

lie  X(  I  )=L/P(  1  ) 

1J7  H  =  l-  +  X(  I  )»X(  I  ) 

1  =  1-1 

Gia  T0   122 

lit     H=l ./SORTF (H ) 

CB  126  1=1. N 
IZP  Z( J.  I  )=X(  I  )«F 
'57  C0NTINL& 
;i  00  35  J=1.M 
00  35  K=3,N 
1F(E(K-1 ) ) 3e.35.3e 
3fc  S  =  C 

I l=K-l 

D0  36  1=1.11 
38  S  =  S  +  A(K.  I  )«Z(  J.  I  ) 

S  =  S/(0(K-1  )»A(K.K-1  )  ) 
D0  37  1=1.11 
:-7  Z(  J,  I  )  =Z  (  J  .  I  )  tS^Al  K,  I  ) 
35  C0NTINLE 
RCTLRN 


H0US1221 
H0US1222 
H0US1223 
H0Ubl?2'» 
H0US 1225 
H0Ubl22e 
H0U51227 
H0US 1228 
H0USI229 
H0US123C 
H0US1231 
H0US1232 
H0US1233 

H0US1235 
H0US123e 
H0US1237 
H0CSl23e 
H0US1239 
H0US124C 
H0US 124 1 
H0US1242 
H0Ub 1243 
H0US 1244 
H0US 1245 
H0Ubl24e 
H0US1247 
M0USl24e 


237  - 


Identification:     H0US2  -  Eigenvalues  and  Eigenvectors 

of  a  Real  Symmetric  Matrix 
7094  -  FORTRAN  II  Coded 
Purpose:   To  find  eigenvalues  and  eigenvectors  of  a  real 

symmetric  matrix. 
Method :    The  matrix  Is  reduced  to  trldlagonal  form  by 
Householder's  method  and  bisected  using  Sturm 
sequencing  to  determine  the  eigenvalues.   The 
eigenvectors  are  computed  using  Wilkinson's 
method.   See  three  articles  by  J.  H.  Wilkinson 
In  Numerlsche  Mathematlk  h,    55^-376  (1962)  for 
a  more  complete  discussion  of  the  algorithms  used. 
Usage:     Entry 

CALL  H0US2(A,N,C,B,E,MR,ML,IT,Z,W,M1,FN0RM) 
where 

A     Is  the  matrix  to  be  solved  given  In  lower 
triangular  form.   The  Initial  contents  of 
A  are  destroyed  by  H0US2. 
N     Is  the  order  of  matrix  A. 

C     Is  a  vector  of  order  N  which  will  contain 
the  diagonal  elements  of  the  trldlagonal 
matrix  upon  exit. 
B     Is  a  vector  of  order  N  which  will  contain 

the  subdlagonal  elements  of  the  trldlagonal 
matrix  upon  exit.    (B(N)  =0.) 
E     Is  a  real  number  used  In  the  bisection 

process.   (See  parameters  MR  and  ML.) 
MR    Is  the  number  of  eigenvalues  which  lie  to 
the  right  of  E  which  will  be  computed  (in 
descending  order) . 
ML    Is  the  number  of  eigenvalues  which  lie  to 
the  left  of  E  which  will  be  computed  (in 
descending  order) . 
IT    Is  the  number  of  bisection  steps  to  be  used 
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Z     is  an  array  which  will  contain  the  eigen- 
vectors.  Z(I,J)  will  be  the  J-th  component 
of  the  eigenvector  corresponding  to  W(I) . 
W     is  a  vector  of  order  Ml  which  will  contain 

the  eigenvalues  upon  exit. 
Ml    will  be  the  number  of  eigenvalues  computed 

by  H0US2. 
FN0RM  will  be  the  infinity  norm  of  the  tridiagonal 

matrix. 
The  routine  contains  internal  vectors  Q,FM,P,R 
and  PINT,  the  size  of  which  must  be  at  least  N 
and  an  internal  vector  X,  the  size  of  which  must 
be  at  least  N+2.   The  following  DIMENSI0N  state- 
ments appear  in  the  routine  as  compiled  and  may 
be  changed  by  the  user  if  necessary. 

DIMENSI0N  A(50,50),  B(50),  C ( 5O ) ,  W(50),  Z(50,50) 
DIMENSI0N  Q( 50 ) , PM( 50 ) , P ( 50 ) ,R ( 50 ) , PINT ( 50 ) , X( 52 ) 
•  H0US2  differs  from  H0US1  in  the  determination  of 
the  bounds  on  the  eigenvalues  to  be  calculated. 
Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
SQRT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS 

c)  Storage 

1650, p^  =  3l62o  locations  including  the  internal 
vectors  plus  the  required  locations 
listed  in  a) . 

35  >  N  >  25   .006N^-.012N-.21(IT)+.012N(IT) 


Time; 


50  >  N  >  35   .014N^-.225N-.24(IT)+.012N(IT)+1 
N  >  50   .014N^-.225N-.24(IT)+.012N(IT)+2 


sec.  approx. 

Author: 

Miriam  Shapiro 

(translated  from  ALGOL  Procedures) 

Date: 

April  1964 
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EIGENVALUES/veCT0RS  0F  A  REAL  SYMCPTRIC 


-  F0RTRAN  II  C0DEO 


CH0LS2  NYU   MATH  UTILITY  /  1-013  /  P.     SHAPIRB 

C  EIGENVALUES  .  eiGtNVECTaRS  0F  THE  REAL  SYMMETRIC  MATRIX  A. 
SUBR0UTINE  H0LS2(A.N,C,B,E.VR.ML.IT.Z.l«.M,FN0RM) 
DIMENSIBN  A(50,50).H(50).C(50),»<50),2(50.50) 
OIMENSI0N  G(£0).FM(50).P<50).B(50).FINT{50),X(52> 
EQUIVALENCE  (lTl,Tl),(IQl.Ql),(IPI.Pl),(IBC0M.BCeNI).(IY,Y) 
8       HC0N1=2OOOCOCOCCOO 

GAyMA=i.OE-ie 

EPSMAC=1.0E-e 

I=N 
30  IF(3-I  )  I  .  1  .2 
I  SIGMA=0 

KK=I-l 

00  3  K=i,KK 
3  SIGMA=SIGMA+A( I ,K)»A( I .K) 

AI=A(  I  .  I-l  ) 

IFt  AI  )5.6.e 
fc  BI=-SQRTF(  SlG^'A) 

G0  T0  7 
5  BI=SORTF(S IGMA  ) 
7  B( I-l )=8I 

IF(BI )8.9.e 
e  H=SIGMA-AI "BI 

A(  I.  I-  1  )=AI-BI 

J=  I-  1 

-J  )  10.  10.  1  I 
0  BJ=0 

K=I-1 


le 


14   IF( J-K  )  12,  12.  1  3 
12  BJ=B J«A(K. J  )»A( I  , 


17  IF(  1-K  )  15,  15.  le 

15  BJ  =  BJ  +  A( J.K  )«A(  I  .K ) 

K=K-1 

G0  T0  17 
Ifc  0(  J  )=BJ/H 

J  =  J-1 

G0  T0  18 
11  HIGK=0 

J=I-  1 
2  1   IF (  1-J  )  19.  19,20 

19  BIGK=BIGK+A( I . J)»0( J ) 
J  =  J-  1 

G0  T0  21 

20  BIGK=B IGK/{2.»H) 
J=I-  1 

22  IF(  1-J  123.23.24 

23  Q(  J  )=Q( J  )-eiGK«A(  I  . J) 
J  =  J-1 

G0  T0  22 

24  J=  I-  1 

25  IFC 1-J )2e,2e,9 


Hau5200l 
H0US2OO2 
H0US2OO3 
H0US2OO4 
H0US2OO5 
H0US2OO6 
H0US2OO7 
H0US2OO8 
H0US2OO9 
H0US2O1O 
H0US2O I  1 
H0US2O12 
H0US2O13 
H0US2O14 
H0US2O15 
H0US2O16 
H0US2O17 
H0US2Oie 
H0US2O19 
H0US2O2O 
H0US2O21 
H0US2O22 
H0US2O23 
H0US2O24 
H0US2O25 
H0US2O26 
H0US2O27 
H0US2O2e 
H0US2O29 
H0US2O3O 
H0US2O31 
H0US2O32 
H0US2O33 
H0US2O34 
H0US2O35 
H0US2O36 
H0US2O37 
H0US2O38 
H0US2O39 
H0US2O4C 
H0US2O4I 
H0US2O42 
H0US2O43 
H0US2O44 
H0US2O45 
H0US2O4e 
H0US2O47 
H0US2O4e 
H0US2O49 
H0US2O5O 
HauS205l 
H0US2OS2 
H0US2O53 
H0US2O54 
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h0US2  -  EIGENVALOES/veCTBRS  BF     A  REAL  SYHMETBIC  MATRIX  -  FBRTRAN  II  C0DED 

26  K=J  H0US2O55 

27  IF( l-K)2e.2e.29  HauS2056 

28  A( J.K)=A( J.K)-A( I, J)»Q(K)-A(I ,K)«C( J)  H0US2O57 
K=K-1  H0US2O5e 
G0  T0  27  M0US2O59 

29  J=J-l  H0US2O6O 
G0  ra  25  M0US2O6I 

q  1=1-1  H0US2O62 

60  T0  30  H0US2O63 

2  I=N  H0US2064 

31  IF(  l-I  )32.32.33  H0US2O6S 

32  C( I)=A( I.I)  H0US2066 
1=1-1  H0US2O67 
G0  T0  31  H0US2O6e 

33  B( 1)=A<2.1 )  H0US2O69 
B(N)=0  H0US2O7O 
FN0RM  =  ABSF(C(  I  ))*ABSF<B(1  ))  H0US207I 
D0  225  1=2. N  HauS2072 
FL=ABSF(e( I-l ) )+ABSF{C(I ) )+ABSF(BtI))  H0US2O73 
IF«FL-FN0Rf )22£.225.226  H0US2O74 

226  FN0RM=FL  HflUS207S 

225  CaNTINUe  H0US2O76 
II=N-1  H0US2O77 
00  227  1=1.11  H0US2O78 
IF(B( I ) )22e.229,22e  H0US2O79 

229  P( 1*1 )=GAyKA«FN0RM«FN0RM  HauS2080 
G0  T0  227  HaUS2081 

226  P( 1*1 )=B( I )»B( I)  H0US2O82 

227  CaNTINUE  HBUS20e3 
p(  1 )=0  H0US2O84 
FLAMB=E  HOUS2085 
ASSIGN  230  T0  ISTEX  M0US2O86 
G0  T0  64  H0US2O87 

230  ID1=IA1-MR  H0US2O88 
I02=IA1+ML  H0US2O89 
IF(  101  )231.232.232  H0US2O9O 

231  101=0  HauS209l 

232  IF(  I02-N-1  )233.234.234  H0US2O92 
234  ID2=N  HaUS2093 

233  10=101  HaUS2094 
M1=0  H0US2O9S 
II=ID2-1  H0US2O96 
00  235  K=1C1.II  H0US2O97 
10=10+1  H0US2O9e 
G=FN0RK  H0US2O99 
H=-FN0RM  HauS2100 
00  236  J=1.IT  HaUS210I 
FLAMB=(G*H)/2.  H0US21O2 
ASSIGN  237  T0  ISTEX  H0US21O3 
G0  T0  64                             •  H0US21O4 

237  1F( IAl-lD)23e.239.239  H0US21O5 

239  H=FLAMB  H0US21O6 

G0  T0  236  H0US21O7 

23e     G=FLAMB  H0US21O8 

236  C0NTINUE  H0US21O9 
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H0US2  -  EIGENVALteS/VECTBRS  0F  A  BEAL  SV»'METRIC  MATRl 


F0RTRAN  II  C0OEO 


235  »i(M  1  )  =  iG*H  )/2. 

G0  T0  96 
t1     P1=0. 

01  =  1. 

IA1  =  0 

D0  65  1=1. N 

Y=(C(  1  )-FLAMB)«Ql-P( 

IF( Y )206.207.206 
206  Tl=Y»3770C0000COC 

1T1=IBC0NI-IT1 

IF(01  )200.209.201 
209  P1=Q1 

G0  TB  202 

200  IP1=1Q1-IT1 
G0  T0  202 

201  IP1=  IQ 1  +  IT  1 

202  1F( Y )203.204.204 

203  IQ1=IY-IT1 
G0  T0  205 

204  IQ1=IY+IT1 
G0  T0  205 

2C7  P1=Q1 
Q1=Y 

205  IF(P1 )66.67.e7 

66  IF(Q1 )68,65.65 
68  IA1= IA1+  1 

G0  T0  65 

67  iFcci )65. 6e.ee 

65  C0NTINUE 

IF(01 )69, 70.69 
70   IF(P1 )69.69,7l 


71 


69  G0  T0  ISTEX. (230.237) 
96  FLAWB  =  FN0R>' 

EPS=EPSMAC»FNaRM 

D0  97  J=1.M1 

FLAMB=FLAMB-EPS 

IF(»(J)-FLAMB)98.99.99 

98  FLAf»B  =  V»(J> 

99  U=C( 1 )-FLAMB 
V  =  B(  1  ) 

IF( V) 100. ICl . 100 
ICl  V=EPS 
ICO   II=N-1 


D0 


102 


1  .1  I 


BI  =  B(  I  ) 

1F(6I  )  103.  104.  103 
1C4  BI=EPS 
1C3  81  l  =  e(  I+l  ) 

1F(BI 1  )  105. 106.105 
1C6  BI1=EPS 
1C5  IF(ABSF(BI)-A8SF(U))107.1Ce.lCe 

ice  FMt i+i )=u/ei 

IF(FM( I+l ) ) 109.1 10. 109 


H0US21 10 
H0US21 1 i 
H0US2i 12 
H0US21 13 
H0US21I4 
H0US2I 15 
H0US21 16 
H0US2I17 
H0US21ie 
H0US21 19 
H0US212O 
H0US212I 
H0US2122 
H0US2t23 
H0US2124 
H0US2125 
H0US2126 
H0US2127 
H0US2128 
H0US2129 
H0US213O 
H0US213I 
H0US2132 
H0US2133 
H0US2134 
H0US2135 
H0US2136 
H0US2137 
H0US2138 
H0US2139 
H0US214O 
H0US2141 
H0US2142 
H0US2143 
H0US2144 
H0US2145 
H0US214e 
H0US2147 
H0US214a 
H0US2149 
H0US215O 
H0US215t 
H0US2152 
H0US21S3 
H0US2154 
H0US215S 
M0US2156 
H0US2157 
H0US215a 
H0US2159 
H0US216O 
H0US2161 
M0US2162 
H0US2163 
H0US2164 
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H0US2  -  E  IGFNVAL(.ES/VECT0RS  BF  A  REAL  SYK'METBIC  KATBIX  -  FeBTRAN  II  C0OEO 

'  IC  IF(e I-EPS)  1  1  I .  1  1  I .  105  MflUS2165 

111  FM{ I+l )=1.  HauS2166 
1C<J  P(  I  )=ei  H0US2167 

Q(  I  )=C(  I ♦ 1  )-FLAMB  H0US2l6e 

R( I )=ei 1  H0US2169 

U  =  V-FM(  1*1  )»C(  I  )  M0US217O 

V=-FM( I* 1 )»R( I )  H0US2171 

FINT(I+l)=l.  H0US2172 

G0  T0  102  MauS2173 

1C7  FM(I4n=BI/U  H0US2174 

P( 1 )=U  H0US2175 

0( I )=v  H0US2176 

R( I )=0  H0US2I77 

U=C(I+1>-FLAV8-FV(I*1)»V  H0US2l7e 

V=eil  M0US2179 

FINT(I*1)=-1  H0U52iaO 

1C2  CBNTiNoe  Haus2iei 

P(N)=0  H0US2ie2 

G(N)=0  H0US2ie3 

R(N)=0.  H0US2ie4 

X(N>1)=0.  H0US2ia5 

X(N*2)=0.  H0US2ie6 

(-  =  0.  H0US2ie7 

FN=N  H0US218e 

eTA=l./FN  H0US2ie9 

I=N  H0US219O 

112  IF( l-I ) 1 13. 1 13. 1 14  H0US219I 

113  O=ETA-0( I )«X( Ml )-R( I )»X( 1+2)  H0US2192 
IF(P( I ) ) 1 15. 1 16. 1 15  H0US2193 

1  16  X(  I  )=U/EPS  M0US219* 

G0  T0  117  H0US2195 

115  X(I)=(J/P(I)  H0US2196 

117  H=H+ABSF ( X ( 1 ) )  H0US2197 
1=1-1  H0US2198 
G0  T0   112  H0US2199 

114  H=l ./H  H0US22OO 
00  lie  1=1. N  H0US22O1 

118  X<  I  )=X(  I  )»F  H0US22O2 
00  119  1=2. N  H0US22O3 
IF(F  INK  I  )  )  120.  120.  121  H0US22OA 

12  1  U  =  X(  I- 1 )  H0US22O5 

X( I-l )=X( I )  H0US22Oe 

x(  I  )=u-Fy (  I  )»x ( i-i  )  Haus2207 

G0  T0  119  H0US22Oa 

120  X( I )=X( I )-FM( I )»X( I- 1 )  H0US22O9 

1  19  C0NTINUE  M0US221O 

l-  =  0.  H0US22I1 

I=N  H0US2212 

li2  IF(  1- n  123 .  123  .  124  H0US2213 

li3  0=X{  I  )-U(  I  )»X(  !♦!  )-R(  I  )»X{  1*2)  H0Ub?2l« 

IF(P(  I  )  )  125.  126.  125  H0US2215 

126  X( I >=U/EPS  H0US2216 

G0  T0  127  H0US2217 

125  X(I)=U/P(I)  Haub22ie 

1J7  l-  =  l-*X(  I  ) 'X  I  I  )  HauS22l9 
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1=1-1  H6US?220 

C0  T0  122  H0US2221 

124  H=l ./SQRTF(H)  M0US2222 

00  126  1=1. N  H0US2223 

128  Z( J.  I  )  =  X<  1  )»H  H0US2224 

97  C0NTINUE  H0US2225 

34  00  35  J=1.M1  H0US2226 
00  35  K=3.N  H0US2227 
1F<B(K-1  )  )36,35.36  H0US2228 

36  S=0  H0US2229 
II=K-1  H0US223O 
00  38  1=1.11  H0US2231 

38  S=S+A(K. I )»Z( J. I )  H0US2232 

S=S/(B(K-1  )«A(K.K-1  )  )  H0US2233 

00  37  1=1,11  H0US2234 

37  Z( J.  I  )=Z( J.  I  )*S»A(K.I )  H0US2235 

35  C0NTINUE  H0US2236 
RETURN  H0US2237 

ENC  H0US223a 
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Identification:  LRCH  -  Eigenvalues  of  a  Real  Symmetric 

Matrix  -  FORTRAN  II  Coded  -  7094 
Purpose:   To  find  all  eigenvalues  of  a  real  symmetric 

band  matrix. 
Method:    The  routine  uses  the  algorithm  for  the  LR-trans- 

formatlon  as  described  In  "The  LR  transformation 

method  for  symmetric  matrices,"  by  H.  Rutlshauser 

and  H.  R.  Schwarz  In  Numerlsche  Mathematlk  5, 

273-289  (1963). 
Input:    The  routine  assumes  that  a  symmetric  matrix  A 

Is  stored  In  core  memory  as  a  band  matrix. 

For  example,  the  matrix 
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0 

1 

0 
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Usage:     Entry 

CALL  LRCH(N,M,A,EPS,L0WER,FLAMB) 
where 
N     =  order  of  the  matrix  A. 

N  should  be  a  variable  and  not  a  constant 
since  its  value  will  be  changed  within  LRCH. 
M     =  width  of  band  form  of  A.   In  the  above 
example,  M  =  3.   Note  that  the  value  of  M 
used  in  LRCH  is  one  greater  than  that  used 
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in  the  ALGOL  procedure  in  the  reference 
cited  above. 

A      =  band  matrix  to  be  solved.   The  initial 

contents  of  A  are  destroyed  by  the  routine, 

EPS    =  desired  tolerance.   Each  computed 

eigenvalue  will  differ  from  the  correspond- 
ing true  value  by  at  most  EPS.   See  the 
reference  given  for  a  complete  discussion 
on  the  use  of  EPS . 

L0WER  =  1,  eigenvalues  will  be  com.puted  in 
ascending  order 
=  0,  eigenvalues  will  be  computed  in 
descending  order 

FLAMB  =  vector  which  will  contain  the 
eigenvalues  upon  exit. 

The  routine  contains  an  internal  matrix  R,  the 

dimensions  of  which  must  be  at  least  (M+N,M) . 

The  routine  as  compiled  includes  the  following 

DIMENSION  statements 

DIMENSI0N  A (50, 50),  FLAMB (5O) 
DIMENSION  R(100,50) 

which  may  be  changed  by  the  user. 
Output :    The  eigenvalues  are  stored  in  the  vector  FLAMB 

in  ascending  order  (descending  if  L0WER  =0). 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

The  routine  also  uses  the  subroutines  necessary 
to  write  an  output  tape.   These  routines  are 
discussed  more  fully  in  the  last  section  of 
this  report. 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  XINT 

c)  Storage 

1079-,Q  =  2067 o   locations  plus  the  locations 
necessary  for  the  array  R  and  for 
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the  required  subroutines  listed  In 
Author:    Miriam  Shapiro 

(translated  ft?om  ALGOL  Procedures) 
Date:     April  1964 
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CLRCH   NYU  MATH  UTILITY  /  I  R0UTINE  11  /  M.  SHAPIRB  LRCHOOIO 

SUBROUTINE  LRCM{N,M,A.EPS.L0*iER.FLAMB)  LHCH0020 

DIMENSION  A( SO tSO) .FLAMB(SO)  LRCH0030 

DIMENSION  R< 100.50)  LRCH0040 

Z=0.0  LHCH0050 

Y=0.  LRCH0060 

IS=0  LRCH0070 

U=0  LRCH0080 

0MECA=.S  LRCHC090 

PHI=.5  LRCHOIOO 

XN=N  LRCHOllC 

NT=X INTFC I .5»S0RTF (XN) )  LRCH0120 

IPA=1  LRCH0I30 

IF(L0WER)2.I.3  LHCH014C 

1  00  4  K=I.N  LRCHOISO 

00  4  J=I.M  LRCH0160 

4  A(K. J)=-A(K. J)  LRCH0170 

3  G=0  LRCH0180 

IST0P=O  LRCH0190 

ICF=0  LRCH0200 

IF(N)2,5.e  LHCH0210 

6  IF( IST0P)2.7.5  LRCH0220 

7  IF(N-I  )  lO.e.  10  LHCH0230 

10  IEN=1  LRCH0240 
ASSIGN  11  T0  INOEF  LRCH0250 
ASSIGN  35  T0  N0ST1  LRCH0260 
G0  T0  13  LRCH0270 

11  ICF=ICF+1  LRCH0280 
IF( Y ) 14. 15. le  LRCH0290 

15  Y=-EPS«) 000000.  LHCH0300 
G0  T0  10  LRCH0310 

14  Y=10.«Y  LRCH0320 

G0  T0  10  LRCH0330 

16  IF(  ICF-3 )  1 7.  18. 17  LRCH034C 
le  Y=0.  LRCH0350 

G0  T0  10  LHCH0360 

17  IF(K-N+2) 19. 19.20  LRCH0370 

19  0MEeA=(0MEGA+ 1 . )•( 0MEGA+1 . )  LRCH0380 
Y=Y/0MEGA-EPS  LRCH0390 
IF( Y) 18.  10. 10  LRCH0400 

20  IF(K-N+l  )2  1,22.21  LRCH0410 

22  n  =  A(N.  I  )-R(N.  1  )-Y  LRCH0420 
V=A(N-1.2)-H<N-1,2)  LRCH0430 
W=X  LRCH0440 
G0  T0  23  LRCH04S0 

21  IF(K-N)23.24.23  LRCH0460 

24  IF(EPS+X)25.25.2e  LRCH0470 
2e  R(N, 1 )=0  LRCH0480 

G0  T0  35  LRCH0490 

25  U=X+R(N- 1 . 2 )«R(N-1 ,2)  LRCH0500 
V  =  R(N-1 .  1  )»R(N-1 ,2)  LRCH0510 
W  =  R(N- 1  .  1  )»R(N-1 ,  1  )  LRCH0520 

23  FH=(U  +  *)/2.-S0RTF(  {U-W)»(L-l«>/4.  +  V»V)  LRCH0530 
IF< W-U )27. 27,28  LRCH0540 
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FH=U-V»V/(*-FH ) 

IF(G )2,2^.30 

FH=. 99999* Y-EPS*FH 

G0  T0  31 

FH=V+FH 

G=l 

IF(FH)  19.32.3Z 

V  =  Fh 

IF{  ICF-1  )  IC. 33. 10 

0MeGA=0MECA/(HVEGA+l.) 

G0  re  10 

Z=Z  +  Y 

IF(  ICF  )36,37.3e 

0MECA=(0MEGA/(0MEGA+1.5))»(0KE6A/(eMeGAtl.5)) 

0MEGA  =  2.»0r'EGA»FH»FH/(FHA»FHA*FHB*FHB) 

PHI  =  .g98»PI-I/(  .99e«PHI»(  l.-0MeGA)*efEGA) 

IF(»eSF(A(N.l))-EPS)e.  38.36 

L  =  L+  1 

FLAMe(L)=Z*A(N.l ) 

IF(L0WER  )2.39.40 

FLAMB(L )=-FLAMB(L) 

00  4  1  J=l .M 

1F( J-l-N )42.4 1 .41 

KK=N-J+I 

A(KK. J )=0. 

C0NTINUE 


NT=X1NTF(1.5«S0RTF(XM)) 

PHI=.5 

0MEGA=.5 

IP=IPA 

IF (  1P-N+  1  )  43 . 44. 44 

PHI=1 

IF{N-2)A5.3e.3e 

IF(  IP-N )4e .47.46 

U=A(N. 1 ) 

V=A(N- 1.2) 

W=A(N-1. 1 ) 

FHA  =  L«V»- V*  V 

G0  T0  4a 

0  =  H(  IP  +  1  .  I  )«R(  IP+1 . 1  ) 

V  =  R(  IP.2  )»R(  IP  +  1  . 1  ) 

l»i  =  R(  IP.  1  )«R(  IP.l  )tR(  IP.2)»R{  IP.2) 
FHA=(R(IP.l)«R(IP*l.l))«(R<IP.l)«B(IP*l.l)) 
FH  =  FHA/((L«V«)/2.  +  SQRTF({Li-»)«(lj-l«)/4.+V«V)) 

Y  =  F(-«PH 
IEN=N-NT+1 
ASSIGN  49  T0  INOEF 
ASSIGN  45  T0  N0ST1 
G0  T0  13 

IF(K-N*1 )5 1.50.50 
IF  ( X+V/2. )51. 51.52 


r0  4; 


LRCH0550 
LRCH0560 
LHCH0570 
LRCHOSeO 
LRCH0590 
LRCH0600 
LRCH0610 
LRCM0620 
LRCH0630 
LRCI-0640 
LRCH0650 
LRCH0660 
LRCH0670 
LRCH0680 
LRCH0690 
LRCH0700 
LRCH0710 
LRCH0720 
LRCH0730 
LRCH0740 
LRCK-0750 
LRCH0760 
LRCH0770 
LRCH07a0 
LRCH0790 
LRCH0800 
LRCHOeiO 
LRCH0820 
LHCHOa30 
LRCH0e4C 
LRCM0850 
LRCH0e60 
LRCH0870 

LRCHoeeo 

LRCH0890 
LRCH0900 
LnCH0910 
LRCH0920 
LRCH0930 
LRCH0940 
LHCH0950 
LRCM0960 
LRCH0970 
LRCH0980 
LRCH0990 
LRCHICOO 
LRCHIOIO 
LRCH1C20 
LHCI-1C30 
LRCH104C 
LRCH1C50 
LRCH1060 
LRCH1070 
LRCHlOeO 
LRCHIC90 
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51  0MEGA=0MECA+1.  LRCHllOO 

Y=.e»Y  LRCHlllO 

45  IS=IS+1  LRCHI120 

G0  T0  3  LRCH1130 

5  00  53  K=l,N  LRCH1140 

A(K,  1  )=Z+A(K,  1  )  LRCHI150 

IF(L0WER  )2.5'>.53  LRCH1160 

S*  00  55  J=l.M  LRChll70 

55  A(K, J)=-A(K. J)  LRCH1180 
S3  CBNTINoe  LRCHM90 

RETURN  LRCH1200 

2  WRITE  0UTPtT  TAPE  6,Q  LRCH12I0 

q  F0RNAT(37t-   ERH0R  IN  VALUE  0F  EBBLEAN  VARIABLE.)  LRCH1220 

RtTLRN  LRCH1230 

13  KK=N*M-1  LRCH1240 

00  56  K=IEN.KK  LRCH12S0 

00  56  J=l.M  LRCH1260 

56  R(K,J)=0.  LRCH1270 
00  57  K=IEN.N  LRCH12S0 
X  =  A(K.  1  )-RlK, 1  )-Y  LHCH1290 
IF( X )5e, 56.59  LRCH1300 

58  G0  T0   INOEF.  (  1  1.49  )  LRCH1310 

59  R(K.  1  )  =  SQRTF(X  )  LRCH1320 
00  60  J=2.y  LRCHI330 

60  R(K,  J  )  =  (  A(K.  J>-R(K.  J)  ) /R(K,1  )  I.RCH134C 
00  57  J=2.f  LRCH13S0 
00  57  I=J,N  LRCH1360 
KK=K+J-1  LRCH1370 
II=I-J*1  LRCHl3eO 

57  R(KK,  I  I  )=R{KK,  U  )  +  R(K. J)»R(K. I  )  LRCH1390 
G0  T0  N0ST  1,  (35,45)  LRCH1400 

35  FH=H( 1,1)  LRCH1410 

FHA=FH  LRCH1420 

FHB=FH  LRCH1430 

IP=l  LRCH1440 

1PA=1  LRCH1450 

00  64  K=1,N  LRCH1460 

FHe=FHA  LRCH1470 

FHA=FH  LRCH1480 

IPA=IP  LRCH1490 

IF(n(K. I )-Fh)62,63,63  LRChlSOO 

62  FH=K(K. 1 )  LRCH1510 
IP=K  LRCHI520 

63  00  64  J=l,M  LRCH1530 
A(K,J)=0.  LRCH1540 
C0  65  I=J,M  LRCH1550 
KK=K+J-1  LRCH1S60 
1I=I-J+:  LRCH1570 

65  A(K. J  )=A(K  .  J  )+R(K,  I  )»R(KK,  I  I  )  LRCH1S80 
IF(A(K.  J  )  164,66.64  LRCHI590 

66  IF(K  +  J-N- 1  )e7.67,64  LRCH1600 

67  A{K. J )=.0C1»EPS  LRCH1610 
£4  C0NTINUE  LRCHI620 

G0  T0  34  LRCH1630 

END  LRCHI640 


Roots  of  Polynomials 

1.  P0LY    Polynomial  Solver  -  FAP  Coded 

2.  PR00T   Polynomial  Solver  -  PORTOAN  Coded 
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Identification:      P0LY  -  Polynomial  Solver 

FAF  Coded  -  709^ 

Purpose:   To  find  all  of  the  roots  of  a  polynomial  with 
real  or  complex  coefficients  of  the  form 
V^  +  A^-X "'  +  .  .  .  +  A3_X  +  Aq  =  0 

Method :    The  program  searches  the  complex  plane  for  the 
roots.   It  takes  zero  as  the  initial  guess  and 
proceeds  from  there,  computing  and  applying 
corrections  which  lead  to  convergence  on  the 
nearest  root.   If  there  is  no  "nearest"  root, 
the  program  applies  a  series  Of  arbitrary  correc- 
tions until  it  is  in  a  position  to  converge  on 
a  root.   After  finding  a  root,  the  program  extract; 
the  factor  corresponding  to  that  root  from  the 
polynomial  and  proceeds  to  find  a  root  of  the 
reduced  polynomial  using  as  a  first  guess  either 
the  complex  conjugate  of  the  root  just  found  (if 
the  coefficients  of  the  original  polynomial  are 
real)  or  the  root  itself  (if  the  original  poly- 
nomial has  complex  coefficients).   After  finding 
all  the  roots  the  program  computes  one  or  two 
corrections  for  each  of  them  except  the  first 
using  the  coefficients  of  the  original  polynomial 
to  eliminate  errors  due  to  Ignoring  non-zero 
remainders  in  obtaining  the  successive  reduced 
polynomials . 

Accuracy:  Seven  decimal  digits  are  obtained  for  isolated 

single  roots.   Three  or  four  digits  are  obtained 
for  multiple  roots  or  roots  that  are  very  close 
together.   Real  or  pure  imaginary  roots  may 
show  a  very  small  imaginary  or  real  part, 
respectively.   The  loss  of  accuracy  when  the 
roots  are  very  close  together  is  due  to  the 
limited  number  of  significant  digits  available 
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In  the  machine.   The  accuracy  becomes  poor  when 
k  roots  are  so  close  together  that  the  ratio  of 
the  radius  of  the  smallest  circle  which  will 
enclose  the  roots  to  theirmean  distance  from 
the  origin  is  less  than  -yiO-^  .   This  difficulty 
cannot  be  overcome  directly  without  using 
double-precision  arithmetic.   Indirectly  it  can 
be  overcome  by  forming  a  new  polynomial  for  which 
the  origin  of  the  complex  plane  has  been  shifted 
to  the  near  vicinity  of  the  roots  the  accuracy 
of  which  is  questioned.   If  the  roots  are 
distinct,  the  solution  of  the  new  polynomial 
will  show  them  as  distinct  and  isolated.   If 
the  roots  are  multiple,  they  will  still  appear 
very  close  together. 
Usage:     Entry 

CALL  P0LYCI,N,C,T1,T2,R,IERR) 
where 

I     indicates  whether  the  coefficients  of  the 
polynomial  are  real  or  complex 
If  I  =  0,   the  coefficients  are  real 

=  1,   the  coefficients  are  complex 
N     is  the  degree  of  the  polynomial  to  be 

solved 
C     is  a  one-dimensional  FORTRAN  II  array 
which  contains  the  values  of  the 
coefficients.   If  the  coefficients  are 
real  (1=0),  they  should  be  stored  as 

C(l+m)  =   A^_^  ,   m  =  0,1,... ,N. 
If  the  coefficients  are  complex  (1=1), 
they  should  be  stored  as 
C(l)  =  Real  part  of  A, 


N 
C(5)  =  Real  part  of  A, 


0(2)  =  Imaginary  part  of  A^^ 


'N-1 
C(^)  =  Imaginary  part  of  A. 


N-1 


255  - 


C(2*N+1)  =  Real  part  of  Aq 
C(2*N+2)  =  Imaginary  part  of  A^ 
Note  that  this  Is  not  the  usual  way  In 
which  a  FORTRAN  II  complex  array  Is  stored. 
The  dimension   of  C  m.ust  be  at  least  (N+1) 
If  the  coefficients  are  real  and  at  least 
2(N+1)  If  they  are  complex.   After  execution 
of  the  routine,  the  coefficients  will  be  In 
reverse  order. 
T1,T2  are  two  one-dlmenslonal  arrays  each  of 

dimension  at  least  2(N+1)  which  are  used 
for  temporary  storage. 
R     Is  a  one-dlmenslonal  array  with  dimension 

at  least  2(N+1)  which  will  contain  the  real 
and  Imaginary  parts  of  the  calculated  roots. 
These  roots  will  be  stored  In  the  same 
manner  as  the  complex  coefficients  Indicated 
above.   If  any  of  the  roots  are  real 
(Imaginary),  the  corresponding  Imaginary 
(real)  part  will  be  set  equal  to  zero. 
lERR   Is  an  error  flag  set  by  the  routine. 

lERR  =  0  the  routine  finished  the  computation 
lERR  =  1  either  the  coefficients  are  out 
of  range  and  cannot  be  scaled  up 
or  down  to  finish  the  computation, 
or  A^  =  0. 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
The  routine  uses  a  subroutine  FPT  to  handle 
overflow  and  underflow  conditions.   This  routine 
is  discussed  m.ore  fully  in  the  last  section  of 
this  report. 
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b)  Storage 

775,„  =  1^05o  locations  plus  the  required 
subroutines  listed  In  a) . 
Author:   M.  Goldstein  (adapted  from  Los  Alamos  routine 

LAS87I  by  J.  K.  Everton) 
Date:     January  I962 
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P0LY  -  P0LVK0HIAL  S0LVER  -  FAP  C0DeO 


i                    FAP 

fNUP0LY 

C0UNT 

eco 

ENTRY 

P0LY 

PBLY  SXD 

X4,4 

TSX 

*FPTEST.« 

TSX 

FPTPR. 

0 

LXO 

X4,  A 

MAXl    CLA» 

2, A 

STC 

New-f2 

ARS 

le 

ST0 

C0MM0N 

ACO 

C0yM0N 

1 

ST0 

cavMBN 

I4-1 

ACC 

0NE 

ST0 

C0f«M0N 

1  +  2 

CLA 

C0NM0N 

1*1 

sue 

0NE 

STB 

C0M^'0^ 

1  +  3 

CLA» 

1  |4 

ARS 

le 

STA 

NEW  +  2 

TN2 

MAX2 

CLA 

3. A 

SOB 

C0^M0N 

STA 

MAXAt 1 

1 

ALS 

le 

STO 

NEW+3 

CLA» 

2.4 

ACC 

O0NE 

ST0 

C0MM0^ 

<*5 

TRA 

NAX3 

MAX2    CLA 

3.4 

sue 

CefMBt' 

J  +  2 

STA 

MAX4> 1 

1 

ALS 

le 

STO 

NE\il  +  3 

CLA 

C0f'N'0N+2 

ALS 

le 

ACO 

D0NE 

ST0 

C0KM0N+5 

MAX3   CLA 

4  .4 

sue 

C0MN0r 

M  +  2 

STA 

NEW  +  4 

CLA 

5.4 

sue 

C0KN'0r 

■^♦2 

ALS 

18 

STO 

NE>.  +  4 

CLA 

6.4 

sue 

C0MM0I 

>i  +  3 

STA 

NEW*3 

STA 

EXIT* 

CLA 

C0MM0I 

M*l 

ALS 

le 

5T0 

SAVE 

2N 
2N+1 


T1-(2N*1 ) 

T2-<2N*l ) 

R-(2N-1) 
2K 


PLYOOOIO 
PLY00020 
PLY00030 
PLY0004C 
PLY00050 
PLY00060 
PLY00070 
PLY00080 
PLY0009C 
PLYOOIOO 
PLYOOl 10 
PLY00120 
PLY00130 
PLYOO140 
PLY00150 
PLY00160 
PLY00170 
PLYOOieO 
PLY00190 
PLY00200 
PLY00210 
PLY00220 
PLY00230 
PLY0024C 
PLY00250 
PLY00260 
PLY00270 
PLY00280 
PLY00290 
PLY00300 
PLY00310 
PLY00320 
PLY00330 
PLY0034C 
PLY00350 
PLY00360 
PLY00370 
PLYOOSeO 
PLY00390 
PLY00400 
PLY00410 
PLY00420 
PLY0043C 
PLY0044C 
PLY00450 
PLY00460 
PLY00470 
PLY00480 
PLY00490 
PLY00500 
PLY005  10 
PLY00520 
PLY00530 
PLY0054C 
PLY00550 
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STA 

MAX4 

TSX 

TSX 

TSX 

TSX 

NEK 

TSX 

THA 

PZE 

P2E 

PZE 

THA 

ERR0R 

CUA 

STC 

TRA 

8KLT 

CLA 

STB 

EX  IT 

TSX 

TSX 

TSX 

TSX 

TSX 

LXO 

eFT^ 

TRA 

0Nfc 

Pl£ 

oeNE 

0CT 

SAWE 

PZE 

ERR0R41 
B0UT+ 1 
FLIP, 4 

C0MM0N+5 
C0N'M0N  +  4 
APEC0,4 
ERR0R 


B0UT 
O0NE 


CeMM0N*4 
SFP0LD,4 


OCOOOIOOOOOO 

0 

0LT.  1 

0LT+1 .2 

1  .2 

=  0777  77000000 


PDX 

,  1 

ARS 

I 

STC 

M0VE»6 

ARS 

1  7 

ADD 

1  .4 

STA 

M0VE 

STA 

M0VE+ 1 

sue 

=  01 

STA* 

3.4 

M0VE 

CLA 

••.1 

LCO 

••,2 

STO« 

M0VE 

ST0« 

M0VE+ 1 

TXI 

•♦1.2.1 

TXI 

•♦  1  .  I  .-1 

TXL 

r'0VE.2.C 

BUI 

AXT 

.  1 

AX  T 

.  2 

TRA 

4  ,4 

APEQO 

SXO 

C0M 

M0N+OOO4.1 

CLA 

0002.0 

F0R  0LTPUT 
A  IMT1ALL1 
B  INITIALL1 


S0LVE  PBLYNBMIi 
ZER0  0R  0NE 


PLYOOSeO 
PLY00570 
PLY0058C 
PLY00590 
PLY00600 
PLY00610 
PLY 0  06 2  0 
PLY00630 
PL Y0064C 
PLY00650 
PLY00660 
PLY00670 
PLY00680 
PLY00690 
PLY00700 
PLY00710 
PLY00720 
PLY00730 
PLY0074C 
PL Y00750 
PLY00760 
PLY00770 
PLY0078C 
PLY00790 
PLY0C800 
PLY0081C 
PLY00e20 
PLY00830 
PLY00e4C 
PLY  00850 

PLYOoeeo 

PL Y00870 

PLYooeao 

PLY00e90 
PLY00900 
PLY00<510 
PLY00920 
PLY00930 
PLY0094C 
PLY00950 
PLY00960 
PLY  009 70 
PLY00980 
PL Y00990 
PL YO 100  0 
PL YO 10 10 
PL YO 10  20 
PL Y0I030 
PL YO 104  0 
PLYO 1C50 
PL YOl 060 
PLYO 1070 
PLYO 108  0 
PLY01090 
PLYO 1 100 
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LBT 

.0 

TRA 

APEQl. 0 

CLA 

0003. A 

ARS 

0018.0 

ACC 

APEC2.0 

STA 

APE03.0 

APEC3 

CLA 

.0 

TNZ 

APEOA .0 

APEQl 

CLA 

0003. A 

ARS 

ooie.  0 

STA 

APEQ5.0 

APeG5 

CLA 

.0 

rzE 

0001. A 

APt04 

sxc 

C0MM0N+CCO5.2 

bXD 

C0>'N"eN  +  GOC6.A 

CLM 

.0 

STA 

C0MM0N*OOO5.O 

GPecii 

CAL 

0003.4 

C0M 

.0 

ACC 

APE02.0 

STB 

C0My0N+ooO2,o 

N0P 

.  0 

N0P 

.  1 

N0P 

.0 

CLA 

OOOA. A 

C0M 

.0 

ACL 

APE02.0 

ST0 

C0WW0N+OO25.O 

apeoe 

LXC 

C0M^'0N  +  OOO2.l 

CLA 

0002.4 

ARS 

0017. C 

SL* 

C0MMeN+OOOO.O 

ACL 

APE06.0 

FAC 

APEOe.O 

SL* 

C0»'MeN  +  oooi  .0 

CLA 

0002,4 

LXA 

C0MM0N*OOOO.2 

SXC 

C0MM0N+OO2O.2 

FPtOJ 

TXI 

APE07.2.0002 

APEG7 

LXA 

C0MM0N+OO25.4 

LBT 

.0 

TRA 

APE08.0 

8Pe03 

CLA 

,  1 

ST0 

.4 

TXI 

RPEQl . l.-COCl 

BPtGl 

TX  I 

BPEQ2.4,-C001 

BPEC2 

T  IX 

BPEQ3.2.0001 

BPEG* 

CLA 

BPEG4 .0 

STC 

RPE05.0 

TRA 

BPEQe.O 

APEG8 

CLA 

,  1 

ST0 

,4 

CLM 

.0 

SLW 

0001.4 

TXI 

BPE07. l.-OOOl 

CBMPLX  CBEFFICIENTS 
ACC=IMAGINARY  PART 


ACC=REAL  PART 
TR  T0  ERR  ST0P 


MAKE  K=0 

CeMFLEMENT  0RIGINS 
FWR  AND  FWC 


F0RM  25  C0MP  0F  N 


ALPHA  1 

ST0RE  2N  FIXED 


^C  N  FL0ATEO 


SET  N  PRIME 

2N42  IN  B 

-  0RIG  TEMP  C0EFS 


ST0RE  C0MPLEX  C0EFS 


ST0RE  REAL  CBEFS 


PL  Y  0  n  1  0 

PLV01120 
PL  YD  11 30 
PLY0114C 
PLY0I150 
PLY01160 
PLY01170 
PLYOl 180 
PLY01190 
PLY01200 
PL YO 12 10 
PLY01220 
PLY01230 
PLY0124C 
PLYOl 250 
PLY01260 
PLY01270 
PLY01280 
PLY01290 
PLY01300 
PLYOl 3 10 
PLY01320 
PLY01330 
PLY01340 
PLY01350 
PLY01360 
PLY01370 
PLY0l3e0 
PLY01390 
PLY01400 
PLY01410 
PLYO 1420 
PLY01430 
PLY0144C 
PLY01450 
PLY01460 
PLY01470 
PLY01480 
PLY01490 
PLY01500 
PLY01510 
PLY01520 
PLY01530 
PLY0154C 
PLY01550 
PLY01560 
PLY01570 
PLYOlSeO 
PLY01590 
PLY01600 
PLYO 16 10 
PLY01620 
PLY01630 
PLY0164C 
PLYOieSO 
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BPE07 

TXI 

BPEQe.A.-00C2 

snpoa 

TIX 

APEQe.2.0002 

CLA 

CPEQl  .0 

STC 

BPCG5.0 

8PfcQ6 

LXA 

CI3MM0N*COOS.  1 

TXH 

CPeQ2.1 

HPtC7 

CLM 

.0 

STB 

C0VM0N+OO13.O 

ST0 

C0MM0N+CO14.O 

IPEC3 

CLM 

.0 

SL» 

C0^'M0^♦ooO3.O 

SL* 

C0MM0N+OOO7.O 

STA 

C0MM0N+COC6.O 

QPE06 

STO 

C0MM0N+OOO8.O 

CLA 

CPEQ3.0 

ST0 

C0MM0N+OO28.O 

CLA 

CPEQA.O 

STA 

C0MM0N+OOO4,O 

HPtC3 

LXA 

C0MM0NtOO25,2 

LXA 

C0MM0NtOOOO.l 

TSX 

CPE05.A 

TRA 

CPE06.0 

sue 

C0NM0N«-OOO9.O 

TNZ 

CPE07.0 

LXD 

C0M^»0N  +  OOO8.l 

TXI- 

CPEOe. 1.0008 

TXI 

DPEQl .1 .0001 

OPECl 

sxc 

C0MM0N+COO8.1 

THA 

DPEQ2.0 

CPEC7 

TMI 

OPE02.0 

CPEC8 

LXD 

C0MMKN+OOO3.1 

TXK 

DPE03 . I 

0PE02 

CLA 

C0MM0N+CO 10.0 

STB 

C0MN'0NtCOO9.O 

LPtC7 

CLA 

cewMfN+oois.o 

ST0 

C0MM0NtOO29.O 

CLA 

C0MM0NtOC 16,0 

ST0 

C0MM0N+OO3O.O 

CLA 

CPEOA.O 

TSX 

DPEQ5.A 

LXA 

C0MM0N+CCOO. 1 

TX  I 

DPEQ6. 1 .-0002 

DPE06 

LXD 

C0MM0N+OO25,2 

TSX 

CPEQ5.A 

THA 

OPE07.0 

UPtO 

CLA 

DPEQ8.0 

TSX 

OPEOS.A 

CLA 

C0MM0N+OO1O.O 

TNZ 

EPEQl .0 

CLM 

.  0 

ADW 

C0MM0NtOO 15.0 

ADM 

C0MM0NtOO16.O 

TNZ 

EPEOP.O 

IPEG6 

LXA 

C0MM0N+OOO5.1 

JK^ 

DPEG3 . 1 

Te  BETA  ; 
BETA  7 
INITIAL  ; 

ALPHA  3 
0  T0  E.F 
L  AND  L  ( 

0  T0  P 
H     ALPh/ 


2  T0  S 

PREP  Ta  C 

evERFLaw 


•0  ALPHA  5 


SET  UP  FaP  DERIVATI 
BETA  4 


T0  BETA  I 
GAMMA  1 
T0  ALPh< 


PLY0I660 
PLV01670 
PLY01680 
PLY01690 
PLYOI700 
PLYO J7  10 
PLY01720 
PLY01730 
PLY0174C 
PL Y01750 
PLY01760 
PLY01770 
PLYOl 780 
PLY01790 
PLYO 1800 
PLYO 1810 
PLY01820 
PLYO 1830 
PLY01840 
PLY01850 
PLY01860 
PL Y01870 
PLYOie80 
PLY01890 
PLY01900 
PLY01910 
PLY01920 
PLYO 1930 
PLYO 1 94C 
PLY01950 
PLY01960 
PLYO 19  70 
PLY01980 
PLY01990 
PLY02000 
PLY02010 
PLY02020 
PLY02030 
PLY0204C 
PLY02050 
PL Y02060 
PLY02070 
PLY02080 
PLY02090 
PLY02100 
PLY021IO 
PLY02120 
PLY02130 
PLY02  14C 
PL Y02  150 
PL Y02160 
PLY02  170 
PLY02  18C 
PL Y02190 
PLY02200 
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CLA  ePE03,0 

ST0  C0MMeN+OO2l tO 

CLM  .0 

SLW  C0MV0N+CC22.O 

TRA  EPeQ<l,0 

EPECl  LCQ  C0MM0N+OO15.O 

TO0  EPEQb.O 

EPEQ5  FMP  C  (5MM0N  +  OO29.  0 

ST0  C0MM0N+OO21 .0 

LCQ  C0MM0N+OO 16.0 

FMP  C0MM0N+OC3O.O 

LCG  C0MM0N+OO21 .0 

T0V  EPEQ6,0 

TSX  EPEG7,1 

TRA  EPEQ6.0 

FCH  C0My0NtCO  10.0 

STQ  C0MM0N+CO21 .0 

LCG  C0MM0N+OO 15.0 

FMP  C0MM0N+CC3O.O 

ST0  C0MM0N+OC22.O 

LCQ  C0MM(?N  +  OO  16.0 

FMP  C0MM0N+OO29.O 

CHS  .0 

LDQ  C0MM0N+OC22.O 

T0V  EPE06.0 

TSX  EPEQ7,1 

TRA  EPEOe.O 

FCI-  C0MM0N  +  CO  10.0 

STO  C0MM0N+CO22.O 

TQ0  EPE06.0 

CLM  .0 

SLW  C0MM0N+OCO7.O 

LXC  C0MM0N+OOO3.2 

TXF  EPEQe.2,0001 

TXl  FPEGl .2.0001 

FPtQl  SXC  C0MM0N+COO3.2 

CLA  C0MMBN+OC21 .0 

3T0  C0MM0NtOO23.O 

CLA  C0MM0N+OO22.O 

ST0  C0MM0N+OO24.O 

TRA  FPEQ2,0 

EPtCS  LXD  FPEG3.1 

FPEGB  CLA  C0MM0N+OO25. 1 

FSB  C0MM0N+OO23.1 

TNZ  FPEQ4,0 

CLA  C0MM0N+OO23. 1 

TZE  FPEQS.O 

TRA  FPEOe.O 

FPfcGA  ST0  C0MM0NtOO  19. 1 

CLA  C0MM0K+OO25. 1 

FCH  C0MM0N+OO 19. I 

STG  C0MM0N+OO19.1 

CLA  FPEQ7.0 

TLO  FPEC6.0 

CLA  C0MM0N+COO1 .0 


1  Te  BX  PRIME 
0  T0  BY  PRIME 


Ga  T0  OISMBUNT 


CYl 

0  T0  L 


CEM0TE 
C0RRECTI0NS 


ACCELERATE 

CeNVERGENCE 

T0WARO 

MULTIPLE 

R00TS 


C0MPARE  FX 
AKO  Ntl 


PLY02210 
PLY02220 
PLY02230 
PLY0224C 
PLY02250 
PLY02260 
PLY02270 
PLY022e0 
PLY02290 
PLY02300 
PLY02310 
PLY02320 
PLY02330 
PL  Y  0  2  JA  0 
PLY02350 
PLY02360 
PLY02370 
PLY02380 
PLY02390 
PLYO2A0O 
PLY024 10 
PLY02A20 
PLY02430 
PLY02A4C 
PLY02450 
PLY02460 
PLY02470 
PLY0248C 
PLY02490 
PLY02500 
PLY02510 
PLY02520 
PLY02530 
PLY0254C 
PLY02550 
PL Y02560 
PLY02570 
PLY02580 
PLY02590 
PLY02600 
PLY02610 
PLY02620 
PLY02630 
PLY0264C 
PLY026S0 
PLY02660 
PLY02670 
PLY02680 
PL Y02690 
PLY02700 
PLY02710 
PLY02720 
._PLY02730 
PLY02740 
PLY02750 
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FAC  ePEC3.0 

LCQ  C0yM0N+OOl9. 1 

TLO  FPEOS.O 

TRA  FPEOe.O 

FPeG5  Tix  FPtae.i.oooi 

LCQ  C0VM0N+OO17.O 
FMP  C0MM0N+OO21.O 

ST0  C0^'^•0N♦oo  17.0 

LCG  C0NM0N+OO18.O 

FMP  C0KM0N+OO22.O 

TO0  FPEQfc.O 

T0V  FPEQ6.0 

ST0  C0MMeN+OO22.O 

CLA  C0MM0N-fCO17.O 

ST0  C0MM0N+CO21 .0 

FPEG6  LXD  FPE05.2 

TRA  FPEQl.O 

FPE02  LXC  FPEQ5.2 

LXA  GPEQl.l 

GPE07  TXI-  GPEQ2.2.0002 

GPEG6  TIX  GPEC3.1.0001 

TRA  GPE04.0 

GPfc03  CLA  C0MM0N+OO15. I 

ST0  C0MM0N+CO 13. I 

T0V  GPEC5.0 

GPEOb  FSe  C0MM0N+OO23. 1 

T0V  DPE03.0 

ST0  C0MM0N*OO15. 1 

SOE  C0MM0N*OO  13.  1 

ANA  C0MM0N>OO28.O 

TNZ  GPEOe.O 

TXI  GPEQ7.2.C001 

CPeOA  LXC  FPEQ3.1 

HPea2  CLA  C0MM0N+OO13. 1 

SUB  C0MM0N*OO23. 1 

ANA  GPEOe.O 

TNZ  HPEOl  ,0 

ST0  C0MM0N+OO 15. 1 

HPhGl  TIX  HPEQ2. 1.0001 

THA  HPEQ3.0 

GPtC?  LXA  C0MM0N+OCO5. 1 

TXt-  HPE04.1 

CAL  C0MM0N+OOOO.O 

STA  HPEQ5.0 

ACC  APEQ2,0 

STA  HPEOe.O 

SUB  CPEQA.O 

STA  HPEQ7,0 

SUE  APEC2.0 

STA  HPEOe.O 

STA  C0MM0N*CCOO.O 


ALPHA    8        FBLLBfcS 


IB  ALPHA  6  CBNWERGEO 

APPLY  CBRRECTieN. 
DEMBTE  X  AND  Y. 
TEST  CBNVEHGENCE 


GB  GET  NEXT  CBRRECTBr 

ALPHA  6 

TB  ALPHA  9 


CL^ 


.0 


ACM  C0MM0N+ 
ACM  C0MM0N+ 
TNZ  IPEQl.O 


0013.0 


00  NBT  ACCEPT  A  ZER0 
R00T  IF  A0  IS  N0T 
ZER0 


PLY02760 
PLY02770 
PLY02780 
PLY02790 
PLY02800 
PLY02810 
PLY02820 
PLY02830 
PLY028A0 
PLY02e50 
PLY02860 
PLY02e70 
PLY02e80 
PLY02e90 
PLY02900 
PLY02910 
PLY02920 
PLY02930 
PLY0294C 
PLY029S0 
PLY02960 
PLY02970 
PLY0298C 
PLYOP990 
PLY03000 
PLY03010 
PLY03020 
PLY03030 
PLY030AC 
PLY03050 
PLY03060 
PLY03070 
PLY03080 
PLY03090 
PLY03100 
PLY03  1 10 
PLY03120 
PLY03130 
PLY03140 
PLY03150 
PLY03I60 
PLY03170 
PLV03180 
PLY03190 
PLY03200 
PLY032IC 
PLY03220 
PLY03230 
PLY03240 
PLY03250 
PLY03260 
PLY03270 
PLY03280 
PLV03290 
PLY03300 
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LXA  C0MM0N+CO25. I 

HPeG5  AOM  0001  .  I 

HPeOe  ADM  0001 ,  1 

TNZ  IPEGS.O 

IPeOl  LXA  C0MM0NtOOO2. 1 

CLA  C0MM0N+OC13.O 

HPEQS  ST0  000 1 . I 

CLA  C0MM0N+OO 14,0 

HPEQ7  ST0  0001 . I 

CLA  C0MN'0N  +  OOO1  .0 

FSB  EPEQ3,0 

5T0  CeMM0N+OOOl .0 

TZE  CPEQ2,0 

LDQ  C0MM0NtOC25.O 

RQL  ooie.o 

STC  C0MMeN+OO25,O 
BPEG5  CLS  C0f'M0NtCO14,O 
ST0  C0MM0N+OO 14.0 
TRA   IPE03,0 
DP6G7  CLA  DPEOS.O 
TSX  DPE05,4 
TWA  CPEOe.O 
ePEG6  LXO  C0MM0N+OOO3. 1 
IXH  IPEC4.1 
LXA  C0MM0N+OOOO. 1 
TXL   IPEQ5. 1.0002 
TRA  IPE06.0 

IPeG4  CLA  C0MM0N+OO23.O 
ST0  C0MM0N+OO21 .0 
CLA  C0N'M0N  +  OO24.O 
ST0  C0MM0N+CO22.O 
CPEG6  LXD  C0MMeN+OOO3. 1 
TXL  IPEQ7.1 

DPeQ3  CLA  C0MM0N+OO 11 .0 
STa  C0MM0N+OO13.O 
CLA  C0MM0N+OO12.O 
ST0  C0MM0N+OO 14.0 
LXA  C0f'M0N  +  OCO5.  1 
TXt-  HPEQ4.1 
CLM  .C 

ADy  C0MM0N+CO21 .0 
SBM  C0MM0N+OO22.O 
TPL  IPEOa.O 
CLM  .0 

IPEOe  ACM  C0MM0N*OO22.O 
ST0  C0MM0N«OO 19.0 
LXD  FPEQ3.1 

JPEQl  CLS  C0MM0N+OO23. 1 
FDH  C0MM0N+OO ig.o 
STG  C0MM0N+CO23. 1 
TIX  JPEG  I  , 1  ,0001 

EPEG4  CLA  APEG2.0 

STA  C0MM0N+COOe.O 
ADD  C0MM0N+OOO3.O 
STA  C0MM0N+COO3,O 


Ta  BETA  6 

GAKMA  2 
STaRE  R00T 

ADDRESSES 

SET 

AEBVE 


T0  BETA  2 


GET  READY  FBR 
NEXT  ReaT 


PLY03310 

PLY03320 

PLY03330 

PLY03340 

PLY03350 

PLY03360 

PLY03370 

PLY03380 

PLY03390 

PLY03400 

PLY03410 

PLY03420 

PLY03430 

PLY03440 

PLY03450 

PLY03460 

PLY03470 

PLY03480 

TB  ALPHA  3  PLY03490 

avF  IN  DERIVATIVE  PLY03500 

RESTaRE  P0LY  INSTRS      PLY03510 

PLY03520 

aVF     IN    C0RRECTI0N  PLV03530 

T0     ALPHA    5  PLY03540 

R0aT     aUT     aF     range  PLY03550 

RETURN     Ta     ERRafi     ST8P  PLY03560 

TB  GAMP«A  1  PLY03570 

PLY035eO 

PLY03590 

PLY03600 

PLY03610 

HERE  FBR  BVERFLBW        PLY03620 

TB  ALPHA  4  PLY03630 

ALPHA  5  PLY03640 

RESTBRE  BLO  PLY03650 

X  AND   Y  PLY03e60 

PLY03670 

PLY03680 

TB  ALPHA  9  PLY03690 

PLY03700 

PLY03710 

PLY03720 

PLY03730 

PLY0374C 

PLY03750 

CM  PLY03760 

PLY03770 

PLY03780 

PLY03790 

PLYO3a00 

PLY03810 

PLY03820 

1  TB  M  PLY03830 

1+F  Ta  F  PLY0384C 

PLY03850 
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CLA 

C0MM0N+OOO3. 

0 

ALS 

0027, C 

ST0 

Cet*M0N  +  OO23, 

,0 

CLV 

.0 

ACM 

C0MM0NtCO13, 

,0 

SDM 

C0MM0N+OO14. 

,0 

TPL 

JPEQ2 .0 

CLM 

.0 

JPE02 

ACM 

C0MM0N*OO14. 

0 

LDQ 

JPE03.0 

TLQ 

JPEQA .0 

CLA 

JPEQS.O 

ST0 

C0MM0N+CO23i 

0 

CLA 

JPEQ3.C 

JPEQA 

ADC 

JPEQ6.0 

STB 

C0MM0NtOO19, 

lO 

LXA 

C0MM0N+OOO3, 

,  1 

JPE08 

SUB 

JPEQ7,0 

TIX 

JPEOe . 1 .0001 

ST0 

C0MM0N-f  0024, 

lO 

LXA 

C0MM0NtCCC3, 

,  I 

TXK 

KPEQl . 1,0003 

LPEOb 

LXD 

APE02. 1 

SXC 

C0MM0NtOOO3. 

,  1 

LXD 

FP603.1 

KPEQ2 

LOO 

C0MMCN+OO23. 

FMP 

C0MM0NtOO24, 

STU 

C0VM0NtOO31, 

FAC 

C0MM0N+OO I5i 

ST0 

C0My0N+OO 15. 

T  IX 

KPE02. 1 .0001 

KPtG6 

LXA 

C0MM0N+COOO. 

.  1 

LXA 

C0MM0N+CO25. 

i2 

TSX 

CPE05.4 

TWA 

KPEOJ .0 

sue 

C0MM0N+OOO9. 

,0 

TZE 

KPeO4,0 

TPL 

KPEQ3.0 

KPEC4 

CLA 

C0MM0N+OOIO. 

,0 

ST0 

C0MM0NtOOO9, 

.0 

CLM 

,0 

STD 

C0MMeN*OOO3, 

,0 

LPECl 

LXO 

FPE03,1 

KPEOS 

CLA 

C0MM0N*OO3I, 

.1 

ACL 

C0MM0N+CO23. 

.0 

bT0 

C0MM0N+CO31 , 

,  1 

FAD 

C0MMeNtOO15, 

.  1 

STB 

C0MM0N*OOlb. 

.  1 

TIX 

KPEQ5. 1,0001 

1 

THA 

KPEOe.O 

KPCQJ 

LXD 

C0MMeN+OOO3, 

.  I 

TXL 

KPE07. 1 

LXA 

C0MM0Ntocoa, 

.  1 

TXH 

KPEoe . 1 

CLA 

CPEC4 .0 

2     TB     THE    F     T0     C 

PLy03Q60 

PLY03870 

PLY03e80 

PLY03890 

PLY03S00 

PLY039J0 

PLY03S20 

PLY03930 

PLY03S40 

PLY03550 

PLY03960 

PLY03970 

PLY03S80 

PLy03S90 

PLY04C00 

c 

PLY04010 

XM/2     llF-7    =     G 

PLY04C20 

PLY04C30 

PLY04C40 

PLY04C50 

PLY04C60 

T0     BETA     3 

PLY04C70 

PLY04080 

1     TB     E 

PLY04C90 

PLY04100 

PLV04  110 

PLY04I20 

PLY04130 

PLY04140 

PLY04150 

PLY04160 

PLY04170 

PLY04180 

PLY04190 

B     BETA     9 

PLY04200 

PLY04210 

PLV04220 

GB     TB     CHANGE     DIRECTN 

PLY04230 

CBING    CBWN 

PLY04240 

OEKBTE     Z 

PLY04250 

PLY04260 

0     T0    E 

PLY04270 

BETA     5 

PLY042aO 

PLY04290 

PLV04300 

PLY04310 

PLY04320 

PLY04330 

PLy04J4C 

PLY04350 

E           BETA     9 

PLY04360 

PLY04370 

f 

PLY04380 

PLY04390 

2     TB     M 

PLY04400 
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STA 

C0MM0N+COO8, 

,0 

CPECl 

CLS 

C0MM0N»OO29, 

,0 

ST0 

C0MM0N+CO29, 

,0 

CLS 

C0MM0N*CO3O, 

,0 

bT0 

C0MM0N+OO3O, 

,0 

TRA 

LPEOl  .0 

KPEoa 

LXC 

FPE03.1 

LPeQ3 

CAL 

C0MM0NtCC31, 

,1 

SUB 

LPEQ2.0 

SLK 

C0MM0N>OO31, 

,   1 

T  IX 

LPEQJ. l.COOl 

KPtG7 

LXC 

FPE03  .  1 

LPFO 

CLA 

C0MM0NtCO 15, 

.1 

FSB 

C0MM0N+OO3t, 

.1 

STIi 

C0MV0N+CO15, 

,1 

TIX 

LPEOa. l.COOl 

I 

LXA 

C0yf0N+COOO, 

,1 

LXA 

C0MM0N<.CO25. 

.2 

TSX 

CPEQ5,4 

TRA 

KPEQ3 ,0 

LXA 

C0N^'0N  +  COO8. 

,  1 

ST0 

C0MM0N+OOO9, 

,0 

CLM 

>0 

TXL 

LPE05. 1 

TXH 

LPEQS.l .0001 

STA 

C0MMf!NtOOO8, 

,0 

CLS 

C0M^'0N♦oo2l  1 

.0 

LCG 

C0MM0N+OO22, 

iC 

ST0 

C0^«M0^♦oo^2. 

,0 

STC 

C0^'M0^♦OO2^, 

.0 

TRA 

LPEGe.O 

LPCQ5 

STC 

C0N'M0N  +  OCG3. 

,0 

TRA 

LPEQT.O 

KPECl 

CLM 

.0 

SL» 

C0MM0NtCO3l. 

0 

CAL 

C0MV0N+CCC6, 

,0 

AOC 

APEG2,0 

STA 

C0MM0N+OOO6. 

0 

CLA 

C0MM0N+OC 19, 

0 

SOB 

LPEOe.O 

LOG 

MPEQl .0 

TLQ 

MPEG2,0 

CLA 

MPEOl .0 

MPfcQ2 

LXA 

C0WM0N+CCC6. 

1 

MPtG3 

ADD 

JPEQ5.0 

TIX 

MPEG3.i.000I 

ST0 

C0MM0N+OO24. 

0 

LXC 

FPEQ3.1 

MPE04 

LOG 

C0MV0N+OO23. 

J 

FMP 

C0VM0N+OO24. 

0 

ST0 

C0MM0N+OO31. 

1 

CLA 

C0MNI0N  +  CC  15. 

1 

ST0 

C0MMeN+OC23, 

1 

TIX 

MPEQ4.1 .0001 

NPLG4 

LXC 

FPEG3.2 

REVERSE  DIHECTI0N 


T0  BETA  5 
BX/2  T0  BX 


T0  BETA  9 


TLRN  90  DEC 
<=1 


T0  BETA  4 

BETA  3 

0  T0  I  AND  J 

1 +P  T0  P 


SET  UP  T0  SEARCt 
BK  SPIRAL 


I   IN  A.2  T0  6 


PLY04410 
PLY04420 
PLY04430 
PLY04440 
PLY04450 
PLY04460 
PLY04470 
PLY04480 
PLY04490 
PLY04500 
PLY04510 
PLY04520 
PLY04530 
PLY0454C 
PLY04550 
PLY04560 
PLY04570 
PLY04580 
PLY04590 
PLY04600 
PLY04610 
PLY04620 
PLY04630 
PLY04640 
PL Y04650 
PLY04e60 
PLY04670 
PLY04680 
PLY04690 
PLY04700 
PLY04710 
PLY04720 
PLY04730 
PLY0474C 
PLY04750 
PL V04760 
PL Y04770 
PLY04780 
PLY04790 
PL Y 0480  0 
PL Y04aiO 
PLY04820 
PLY04830 
PLY04840 
PLY04850 
PLY04860 
PLY04870 
PLY0488C 
PLY04890 
PLY04900 
PLY04910 
PLY04920 
PLY04930 
PLY04940 
PLY04g50 
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FAP     CODED 


MPtoa 

CLA 

CBMMBN+0031. 1 

FDI- 

MPEQ5.0 

STO 

CBMMBN+COIQ.O 

CLA 

CBMMBNtCOl^.O 

TXL 

MPEG6.1.000I 

CHb 

.0 

MPEQ6 

FAD 

CBMMBN+0C31.2 

FAD 

CBMMeN+C023,2 

STB 

C0MMBN  +  OO  15.2 

TXI 

MPEQ7.1 .0001 

MPCC7 

TIX 

MPE08.2.CC01 

LXA 

CB^'^'BN4^oooo.  i 

LXA 

C0MMBN+OO25.2 

ISX 

CPE05.A 

TRA 

IPEQ7.0 

SUB 

CBMMBN+COOQ.O 

t,;e 

NPECl .0 

TPL 

NPEQ2.0 

CLA 

CBMM^N+CC 10.0 

STB 

CBMMHN+0009.0 

CLA 

APE02.0 

STA 

CBMMBN+C031.0 

NPtOS 

LXD 

FPEQ3. 1 

NPeo3 

CLA 

C0MV?N+OO15,1 

Fse 

CewM0NtOO23. 1 

STB 

C0MMBN+OO31 . I 

r  IX 

NPEQ3 . 1 .COOl 

TKA 

NPEa4  ,0 

NPQCl 

LXA 

CB^'MBN♦0031.1 

TXL 

NPEOS.l 

NPt02 

LXA 

CBMMBN+0C31.I 

TXF 

NPEoe.i 

LXD 

CeMMBN+0031.1 

rxH 

NPE07.  1.0020 

TXI 

NPEoe. 1 .0001 

NPEOO 

SXD 

CBMMeN+0031 . 1 

TRA 

NPE05.0 

NPE07 

CLA 

CBMMBN+C022.0 

STB 

CBMM0NtCOl4.O 

CLA 

C0MMeN+CO21 .0 

STB 

CeMWBN>00 13.0 

TRA 

GPEa2  .0 

NPKQ6 

CLA 

CPEQt.O 

AD^« 

C0MMHN+CCO4.O 

STA 

CBKMBN+OOOA.O 

STA 

BPEOl  .0 

STA 

0PEO2.O 

CLA 

CPEQ3.0 

BPEOl 

ARS 

0002.0 

0PtQ2 

ALS 

0002,0 

STB 

CBMMBN+COZB.O 

CLA 

APeQ2.0 

STA 

C0^'^«0^♦ooo3.O 

LXD 

FPE03 . 1 

0PFO3 

CAL 

C0MM0N»CO31 . I 

HERE    F0R    Zl=20 


e   ALPt-A   6 


DECREASE 
BITS  FBH 
CeNVEBCENCE 


PLV04960 
PLY0A970 
PLY0A9e0 
PLY04990 
PLY05000 
PLY05010 
PLY05020 
PLY05030 
PLY0504C 
PLY05050 
PLY0S060 
PLY05070 
PLY05080 
PLY05090 
PLY05100 
PLY051 10 
PLY05120 
PLY05130 
PLY05  14C 
PLY05150 
PLY05160 
PLY05170 
PLYOSieO 
PLY05190 
PLY05200 
PLY05210 
PLY0b220 
PLY05230 
PLY0524C 
PLY05250 
PLY05260 
PLYOb270 
PLY05280 
PLY05290 
PLY05300 
PLY05310 
PLY05320 
PLY05330 
PLY0b3AC 
PL Y05350 
PL Y05360 
PLY05370 
PLY053eO 
PLY05390 
PLY05400 
PLY05A 10 
PLYObA20 
PL Y05430 
PLYOSAAO 
PLY0SA50 
PLY05A60 
PLY05470 
PLYOSASO 
PL Y05A90 
PLY05500 
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P0LY  - 

-  P0LYK0I 

sue  jPEce.o 

SLW  C«MM0N+OC3l . 1 

TIX  0PeO3. 1 ,0001 

CLM  .0 

STA  C0MM0N+OOOH.O 

TRA  LPeOl .0 

CPEQ2  LXD  C0Mr'«NtCOO6.A 

LXA  C0VMHN4-OOO5,  I 

TXH  0PEO4.1.OCO2 

TXL  0PeQ5. I 

RPeQ3  LXD  C0MM0N+CCO4 . 1 

L.XO  ceMMeN  +  0005.2 

THA  0005.4 

0PQO5  CLA  0002.4 

ARS  0017,0 

STA  C0MMeN+OOO5,O 

TRA  0Peoe.o 

0PEQ4  CAL  Ci)MM0N  +  CCC5.O 

SUB  CPEQA.O 

STA  CKMMUN+COOS.O 

sue  CPEQ4.0 

STA  0PEQ7.O 

STA  0PEQe.O 

LXD  FPEG3.1 

LXA  C0MM0N*OOO2,2 

0PCQ7  CLA  .2 

ST0  C0MM0N+OO 15. I 

ST0  CB^r'KN  +  OO  13.1 

TXI  PPEOl,2.-00Cl 

PPEGl  TIX  0PEQ7,1.COO1 

TRA  IPEQ3.0 

HPeG4  CLA  CeMM0N  +  OO  13.0 

FAC  C0MM0N+OC 14.0 

ST0  C0MM0N+CO 19.0 

LXD  FPEQ3,1 

LXD  PPEOl .2 

PPCG4  CLA  C0MM0N+OO 19.0 

FSB  C0MM0M-CC  15.  1 

TNZ  PP£a2.0 

ST0  C0I'M0N  +  OO  15.2 

PPEG2  TXI  PPEQ3.2.0C01 

PPEG3  TIX  PPEO4.1.CC01 

LXA  C0^'^'0N+COC2.^ 

LXD  FPe03.1 

PPtG6  CLA  C0MM0N+CO 15. 1 

MPEOa  STB  .2 

TXI  PPEQ5.2.-0001 

PPEC5  TIX  PPE06.1.0001 

TRA  CPEQ2.0 

QPEG8  SXD  C0MM0N+CO19.4 

STB  C0MM0N+CO23.O 

T0V  PPE07.0 

PPbG7  LXA  C0MM0N+COCO. I 

TXI  PPEGe.l.CC02 

PPECe  LXA  C0^'M0N♦CC25.2 

[AL     S0LV6R 


FAP     C0CEO 


Te     BEl 
BETA     2 


I00T    F0R 
.     C0RRECT1 


T0     ALPh 
ALPHA    <; 


IF(X1 
>     T0 


STKRE  REFINED 
RBBT 


re  BETA  2 

SCALE  C0EFS  AND 

ST0RE  D 

INTERCHANGE  0RIG1 


PLY05510 
PLY05520 
PLY05530 
PLY05540 
PLY0E550 
PLY05560 
PLY05570 
PLY055eO 
PLY05590 
PLY05600 
PLY05610 
PLY05620 
PLY05630 
PLY05640 
PLY05650 
PLY05660 
PLY05670 
PLY05680 
PLY05690 
PLY05/00 
PLY05710 
PLY05720 
PLY05730 
PLY05740 
PLY05750 
PLY05760 
PLY05770 
PLY05780 
PLY05790 
PLY05800 
PLYOSaiO 
PLY05e20 
PLY05e30 
PLY05840 
PLY05850 
PLY05860 
PLY05870 
PLY05e8C 
PLY05890 
PLY05900 
PLY05910 
PLY05920 
PLY05930 
PL Y05940 
PLY05950 
PLY05960 
PLY05970 
PLY05980 
PLY05g90 
PLY06000 
PLY06010 
PLY06020 
PLY06030 
PLY06040 
PLY06050 
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tQ< 


LXD 
LDQ 
CLA 


TZE  QPEOl  .0 

FMP  C0MM0N+CO23tO 

TNZ  QPEOl  .0 

CLA  C0MM0N+OO23,O 

LLS  0010,0 

QPEOl  ST0  ,4 

TXI  QPEQ2.4 t-0001 

QPEOa  TXI  QPEQ3.2.-0001 

GPEC3  TIX  QPEOA , 1 .0001 

CLM  .0 

STD  C0MM0NtOOO3.O 

T0V  OPEQS.O 

RPEC2  LOG  C0MM0N+OO25.O 

RGL  ooie.o 

STC  C0MM0M+CO25.O 

TRA  QPEQ6.0 

QPEC5  LXD  C0MM0N  +  OO  19.A 

SPEQ2  CLM  ,0 

ADM  C0MM0N  +  CO  13.0 

ADM  C0MM0N+OO 14.0 

TRA  000  1  .4 

IPEQ7  CLA  APeQ2,0 

STD  C0MM0N+OOO7.O 

CLA  QPEQT.O 

TSX  QPEOe.A 

TNZ  RPEOl.O 

RPEGa  LXD  C0MM0N+OO25. 1 

ADM  .  1 


ADM 

0001. 1 

I 

TNZ 

RPEQ2, 

,0 

tPE05 

LXD 

C0MM0r 

4+0006.4 

TXI 

RPEQ3, 

,4,0004 

RPEGl 

LXA 

C0MM0h 

^♦0005. 1 

TXh 

HPeQ4, 

.  1 

LXO 

C0MM0^ 

4  4-0020,  1 

TXI 

RPEQ4 , 

,  I  .-0001 

RPE04 

bXD 

RPEQ5 . 

.  1 

LXA 

C0MM0r 

4+COOO. 1 

RPEQS 

TXH 

RPEQ6, 

,1.0001 

SPE07 

SXO 

C0MM0r 

•J  +  0020.1 

TWA 

RPEQ7, 

•  0 

RPfc06 

CLM 

.0 

SL*  C0MM0N+CO 13.0 

SLK  C0MM0N+OO14.O 

TRA  RPECa.O 

EPE02  LXD  C0MM0NtOOO7. 1 

TXH  SPEGl.l 

TSX  SPE02,4 

TRA  SPE03.0 

SPEOl  CLA  SPEQ4.0 

TSX  QPEQe.4 

SPEC3  TZE  IPEQ6,0 


TURN  0N  0VF  TRIGGER 
FBR  UNOERFL0W 


\e     ALPHA  2 


T0     SCALE    OflEFS 


UNOERFL0WED 


T0     ALPt-A    9 


DEC   SET  ABBVE 
RESET  N  PRIME 
TB  BETA  7 


G0  T0  SCALE  CeEFS 
T0  GAMMA  1 


PLY06060 
PLY06070 
PLY06080 
PLY06090 
PLYOeiOO 
PLY061 10 
PL Y0ei20 
PLY06130 
PLY06  14C 
PLY06150 
PLY06160 
PLYOei 70 

pLYoeieo 

PLY06190 
PLY06200 
PLY06210 
PLY06220 
PLY06230 
PLY06240 
PLY06250 
PLY06260 
PLY06270 
PLY06280 
PLY06290 
PLY06300 
PLY06310 
PLY06320 
PLY06330 
PL Y 06 34 C 
PLY06350 
PLY06360 
PLY06370 
PLY063eO 
PLY06390 
PLY06400 
PLY064 10 
PLY06420 
PLY06430 
PLYO6440 
PLY06450 
PLY06460 
PL Y06470 
PLY06480 
PL YO 64 90 
PLY06500 
PLY06510 
PLY06520 
PLY06530 
PLY06540 
PLY06550 
PLY06560 
PLY06570 

PLYoeseo 

PL Y06590 
PLY06600 
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LXA  C0MM0N+OOO5.1  PLY06610 

TXH  HPEQA.l  TB     ALPHA    9                                           PLY06620 

LXO  C0MM0N+OO2O. 1  PLY06630 

TXI  SPEQ5.  1 .-QOCl  PLYOeaOO 

SPEQ5     3XD  SPE06.1  PLY06650 

LXA  C0MM0N+OOOO . 1  C0EF        0veRFL0W                              PLY0e660 

5PEQ6     TXI-  IPEOS.l.OOOl  TB    ERRBR     ST0P                                 PLY06670 

TRA  SPEQ7,0  PLY06680 

IP&Q2    LXD  C0MM0N+OCO7.1  BETA     6                                                        PLY06690 

TXH  IPEOl.l  TB    GAMt'A     2                                           PLY06700 

CLA  SPEQ4.0  PLY06710 

TSX  QPEOe.*  PLY06720 

Th*A  IPEQl.O  TB     GAKMA     2                                              PLY06730 

CPEOb     SXD  C0MM0N+OOOO.4  PLY06740 

LXD  C0MM0N4-OO25.4  PLY06750 

CLA  ,2  PLY067t)0 

ST0  C0MM0N>OC 15.0  PLY06770 

TPEC6     5T0  ,4  PLY06780 

CLA  0001.2  PLY06790 

ST0  C0MM0N+CO 16.0  PLYOeeOO 

TPEQ7     ST0  0001.4  PLY06810 

T0V  SPEOe.O  PLY06820 

SPEQ8     TNX  TPEQl.l  PLY06e30 

TPEQ5     SXC  C0MM0N+OO19. I  PLY06e40 

LOO  C0MM0N+CC13.O  PLY06850 

FMP  C0^'M0^  +  OO  15.0  PLY06860 

ST0  C0yM0N+OO 17,0  AX     -     BY     =     U                                        PLY06e/0 

LOG   C0MM0N  +  OO  14.0  PLYoeeao 

FMP     C0MM0N+CO16.O  PLY06890 

CHS     .0  PLY06900 

PLY06910 
PLY06920 
FL0ATING    ADD  PLY06930 

PLY06940 
PL Y06950 
PLY06960 
PL Y06970 

PLYoegao 

PLY06990 
PLY07000 
PL  Y070 1 0 
PLY07020 
PLY07030 
PLY0704C 
PLY07050 
PLY07060 
U  ♦  Al=  A2  PLY07070 

PLY07080 
PLY07090 
PLY07100 
PL Y071 10 
PLY07120 
PLY07130 
PL Y07140 
PLY07150 
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LDQ 

C0MM0N+OO17, 

,0 

T0V 

TPEQ2.0 

TSX 

EPEQ7. 1 

TRA 

TPEQ2.0 

ST0 

CeMM0NtOOl7, 

,0 

LDG 

CaMM0N+CO13.O 

FMP 

C0MM0N+OO16i 

,0 

ST0 

C0MM0N+OO 

18, 

.0 

LDO 

C0MMeN*OO 14, 

.0 

FMP 

C0MM0N+OO 

15, 

.0 

LDG 

C0MM0NtOO 

16, 

.0 

T0V 

TPEQ2.0 

TSX 

EPEQ7,1 

TRA 

TPEQ2.0 

ST0 

C0MM0N+OO 

18 

.0 

CLA 

0002.2 

LDQ 

C0MM0N+OO 

17 

.0 

TSX 

EPE07. 1 

TRA 

TPEQ2.0 

PEca 

ST0 

0002.4 

bT0 

C0MM0NtOO15 

.0 

CLA 

0003.2 

LOG 

C0MM0N  +  OO  18 

.0 

TSX 

EPe07.  1 

TRA 

TPE02.0 

P0LVK0VIAL  S0LVER  -  FAP  C0CEO 


OPFQl  ST0  0003i4 

ST0  C0MM0NtOO16tO 

TXI  TPeQ3.A,-00C2 

TPEGJ  TXI  TPEQ4,2.-00C2 

TPECA  LXC  C0^'M0^♦OO  19,  I 

TIX  TPEQS. 1.0002 

TPEOl  LXC  C0MM0N+OOOO.4 

LOG  C0MW0NtCO 15.0 

FMP  C0MMHN+CO 15.0 

ST0  C0MNI0N  +  OO  10.0 

LCG  C(?MM0N  +  OO16.O 

FMP  C0MM0N+OO 16.0 

FAD  C0My0N+CO 10,0 

STB  C0MNI0N  +  OO  10,0 

T0V  0001,4 

UPE02  T2E  GPe02.0 

T«A  0002,4 

TPEC2  LXD  C0VM0N*OOOO,4 

TRA  0001  . 4 

0PE05  STC  TPEOe.O 

STD  TPEOy.O 

STC  TPEQB.O 

STC  UPEQl.O 

STA  LIPEQ2,0 

TRA  0001,4 

EPEC/  STC  C0MM0NtOO26,O 

ST0  CHMM0N+OO27,O 

ACC  C0MV0N+CO26,O 

ANA  C0MMONtOC28.O 

TZE  0002,1 

T0V  UPEQ3.0 

UPEQl  CLA  C0MM0N-»CC26,O 

FAD  C0yM0N+CO27,O 

TN0  0002. 1 

TRA  0001  .  1 

CP604  0CT  OO00OC000GO2 

CPec3  0CT  777377777774 
APeC2  P^E       0001.0,0001 

APtQ6  DEC  ♦1.54000000000E+02BOe 

MPECl  0CT  0ei4CC0CCC0C 

0PEG4  N0P  UPE04,0 

DPECa  ST0  GPE02.0 

ePEC3  DEC  ♦ 1 .OOOOCOOOOOOE+00 

OPtC/  0CT  17340000CCOO 

SPE04  0CT  207400000000 

FPfcG7  DEC  -f  1.9000CC00000E  +  OO 

GPEGB  0CT  777360000000 

LPE02  0CT  OOIOOOOCCCOC 

JPEQ5  0CT  00300COOOOOO 

JPEC6  0CT  O070OCOC00O0 

JPEa7  0CT  O13OOCO000O0 

JPEC3  0CT  1014CC00CC00 

LPEC8  0CT  027000000000 

MPE05  DEC  ♦3.00000000000E+00 
FPTPH   PZE       0 


Te  ALPKA  6  0R  7 


CHANCE  EVAUATI0N 
RBUTINE  F0R  GETT ING 
DERIVATIVE 


FLBATIKG  ADO 


GIVES  ZER0  F0R 
A-B    IF  A  ANC  e 


THE  LAST  S  BITS 


PLY07160 
PLY07170 
PLY07180 
PLY07190 
PLY07200 
PLY07210 
PLY07220 
PLY07230 
PL Y07240 
PLY07250 
PLY07260 
PLY07270 
PLY072eO 
PLY07290 
PLY07300 
PLY073  10 
PLY07320 
PLY07330 
PLY07340 
PLY07350 
PLY07360 
PLY07370 
PLY07380 
PLY07390 
PLY07400 
PLY07410 
PLY07420 
PL Y07430 
PL  YO 74 4  0 
PLY07450 
PLY07460 
PLY07470 
PLY07480 
PLY07490 
PLY07500 
PLY07510 
PLY07520 
PLY07530 
PLY0754C 
PL Y07550 
PLV07560 
PLY07570 
PLY07580 
PLY07590 
PLY07600 
PLY07610 
PLY07620 
PL Y07630 
PL Y07640 
PLY07650 
PLY07660 
PLY07670 
PLY076eO 
PLY07690 
PLY07700 
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P0LY  -  P0LYN0HIAL  S0LVER  -  FAP  CaCED 


PLY077I0 
PLY07720 
PLY07730 
PLY07740 


270 


Identification:      PR00T  -  Polynomial  Solver 

FORTRAN  II  Coded  -  7094 
Purpose:   To  find  all  the  roots  of  a  polynomial  with 
real  coefficients  of  the  form 

A^  +  AgX  +  .  .  .  +  Aj^_^^X^  =  0 
Method:    The  routine  converges  simultaneously  toward 
a  linear  factor  and  a  quadratic  factor  by 
Newton's  and  Bairstow's  methods,  respectively. 
When  a  root  is  found  by  one  method,  iteration 
continues  with  both  methods  using  their  most 
recent  guesses. 
Usage:     Entry 

CALL  PR00T(N,A,U,V,H,B,C,C0NV) 
where 
N     is  the  degree  of  the  polynomial  to  be 

solved. 
A     is  a  one-dimensional  array  the  dimension 

of  which  is  at  least  N+1 .   The  coefficients 

of  the  polynomial  should  be  stored  in  this 

array  in  the  order  indicated  above. 
U     is  a  one-dimensional  array  (dimension  _>  N) 

which  will  contain  the  real  parts  of  the 

roots . 
V     is  a  one-dimensional  array  (dimension  _>  N) 

which  will  contain  the  imaginary  parts  of 

the  roots. 
H,B,C  are  each  one-dimensional  arrays  (each 

dimension  _>  N+2)  which  are  used  for 

temporary  storage. 
C0NV  is  a  floating  point  Indicator  set  by  PR00T 

to  indicate  any  difficulty  encountered  in 

solving  the  polynomial.  C0NV  is  initially 

set  by  PR00T  to  l.OE-20,  far  above  the 

actual  starting  convergence  criterion 
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which  Is  5.OE-8  for  the  709^.   If  the 
polynomial  has  not  converged  after  a 
prescribed  number  of  tries,  the  conver- 
gence criterion  is  relaxed.   If  upon  exit 
from  PR00T  the  value  of  C0NV  is  different 
from  l.OE-20,  the  convergence  criterion  haj 
been  relaxed  to  the  number  given. 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  SIGN 

c\   Storage 

655-1  (-N  -   1173o  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:    Miriam  Shapiro  (Adapted  from  Los  Alamos 

routine  LA-PR00T  by  T.  L.  Jordan) 
Date:      December  1964 
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PBLYNeWIAL  S0LVER  -  FflRTBAN 


StlERBUTlNe  PRaaTCN.A.U.V.H.B.C  .C0NV)  PRTOOOIO 

CIMENSI0N  A( 200)  .0(200 )  .V(200)  .H(201  )  .H(20J  )  .C(20l  »  PRT00020 

C0NV=l.OE-2O  PRT00030 

NC=N+1  PRrO0O«C 

SEND  C0EFFICIENTS  T0  REDUCED  C0EFFICIEKT  ST0fiAGE  PRT00050 

D0  1   1=1. NC  PRT00060 

1  H( I )=A( I )  PRT00070 
INITIALIZE  GUESSES  AND  SET  REVERSAL  1NDICAT0R  N0RMAL                       PRTOOOSO 

P=0.0  PRT00090 

0=0.0  PRTOOIOO 

H=0.0  PRTOOllO 

IHEV=1  PRT00120 

SCALING  T0  BE  O0NE  AT  THIS  P0INT                                                PRT00130 

fitM0Vfc  ALL  ZER0  R00TS  PRT0014C 

3  lF(l-(n)4.2,4  PRT00150 

2  NC=NC-1  PRT00160 
V(NC)=0.0  PHT00170 
UINC)=0.0  PRT00180 
00  1002  1=1. NC  PRT00190 

10C2  t-(I)=H(l  +  l)  PRT00200 

G0  T0  3  PRT00210 

TEST  F0R  VAHI0US  DEGREES  PRT0C220 

4  IF(NC- I )5, 100.5  PRT00230 

5  IF(NC-2 ) 7.e.7  PRT0024G 
e  R  =  -K1)/H(2)  PRT00250 

G0  T0  50  PRT0C260 

7  IF{NC-3)q.e.9  PRT00270 

8  P  =  K2)/H(3)  PRT002e0 
Q=H{1)/H(3)  PRT002qO 
G0  T0  70  PRT00300 

TEST  T0  REVERSE  CaEFFICIENTS  AND  D0  SB  IF  TEST  SUCCEEDS  PRT003I0 

9  IF{ AeSF(H(NC-l  )/H(NC  )  )-ABSF(H(2)/h(  1  )  )  )  10. 19. 19  PHT00320 

10  IHEV=-IREV  PRT00330 
M=NC/2  PRT0034C 
D0  11  1=1. M  PRT00350 
NL=NC+1-I  PRT00360 
F=H(NL)  PRr00370 
H<  NL  )=!-(  I  )  PRT00380 

11  H( I )=F  PRT00390 
IF(0) 13. 12.13  PRT00400 

12  P=0.0  PRT00410 
G0  T0  15  PRT00420 

13  P=P/0  PRT00430 
0=1.0/0  PRT00440 

15  IF(R ) 16, 19. le  PRT00450 

16  H=1.0/H  PRT00460 
NEVi(T0N,  CALCULATE  F(R)  AND  TEST  F0R  Re0T  PRT00470 
19  E=5.0E-0e  PRT004eO 

B<NC)=H(NC)  PRT00490 

C{NC)=I-(NC)  PRTOC500 

a(NC*I)=O.C  PRT00510 

C(NCtl)=0.0  PRT00520 

NP=HC-1  PRT00530 

iO    C0  49  J=1.1CC0  PRT00540 
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PR00T     -     PffLVNewiAL     50LVeR     -    FBRTBAN     II     C0CEC 

00  21  11=1. NP  PRT00550 

I=NC-I  1  PRTOOS60 

B(  I  )=H(  n+H«B(  !♦!  )  PRT00S70 

21  C( I )=B( I )tR»C< I+l )  PRT00580 
IF(ABSF(B(l)/htl>)-e 150. 50.24  PRT00590 

24  IF(C(2) )23. 22. 23  PHT00600 

22  R=R+1.0  PRT00610 
G0  T0  30  PRT00620 

23  R=R-B( 1 )/C(2)  PRT00630 
WAKE  A  BAIRST0W  ReOLCTI0N  AND  C0RRECT  PRT00640 

30  00  37  11=1. NP  PRT00650 
I=NC-I1  PRT00660 
B(I)=P(I)-P»6(I+l)-Q»8(I+2)  PRT00670 

37  C(  I  )=0(  I  )-P»C(  I  +  l  )-Q«C(  1+2)  PRT00680 

TEST  F0R  C0NVERGENCE  0F  HAIRST0X  PR0CESS  PRT00690 

IF(F( 2 ) )32 .31 . 32  PRT00700 

31  IF( ABSF(D(2)/K 1 ) )-E)33,33.3A  PRT00710 

32  IF( ABSF(8( 2)/H(2) )-E)33.33.34  PRT00720 
23     IF(ABSF(B( 1 )/H( 1 > )-E)70. 70.34  PRT00730 

34  C8AR=C(2 )-B(2 )  PRT00740 
D=C( 3)»»2-CBAR»C(4 )  PRT00750 
IF(C  )  36. 35.36  PRT00760 

35  P=P-2.0  PRT00770 

o=Q«<o+i.o)  pRroo7eo 

Gk)  T0  49  PRT00790 

36  P  =  P+(B(2)»C( 3)-B(  t  )»C( 4)  )/0  PRT00800 
0=Q+(-B(2)«CBARtB(l)«C(3))/0  PRTOOfllO 

49  C0NTINUE  PRT00820 
E=e»lC.O  PRT00830 
IF(E-C0NV ) 20.20.40  PRT00e4C 

40  C0NV=E  PRTOOaSO 

G0  T0  20  PRT00860 

LINEAR.   C0MPLTE  AND  ST0HE  LINEAR  R0eTS  PRT00e70 

50  NC=NC-1  PRTOOaaC 
V(NC)=0.0  PRT00e90 
IF( IREVJS 1 .52. 52  PRT00900 

51  U(NC)=1.0/R  PRT009I0 
00  T0  53  PRT00920 

52  U(NC)=R  PRT00930 

53  00  54  1=1. NC  PRT00940 

54  H(!)=B(I+1)  PRT00950 
G0  T0  4  PRT00960 

CUADMATIC.    S0LVE  QLADRATIC  AND  ST0RE  R00TS  PRT00970 

70  NC=NC-2  PRT00980 
IF(  IREV)71  . 72. 72  PRT00990 

71  QP=1.0/0  PRTOIOOO 
PP=P/(Q»2.0)  PRTOIOIO 
G0  T0  73  PRT01020 

72  QP=Q  PRT01030 
PP=P/2.0  PRT0104C 

73  F=(PP)»«2-0P  PRT01050 
IF(F ) 74. 75 .75  PRT01060 

CASE  0F  IMAGINARY  R00TS  PRT01C70 

74  U(NC+1)=-PP  PRT01080 
L(NC)=-PP  PRT01C90 
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PReaT  -  PHLYNBWIAL  S0LVER  -  F0RTRAK  II  CBDED 

V(NC*l  )  =  SOr-ITF(-F  )  PRTOllOO 

V(NC)=-V(NC*1 )  PRTOlllO 

G0  Ml     76  PRT01120 

CASE  HF  REAL  R00TS  PRT01130 

75  U(NC  +  1  )=-S  IGNF  ( ABSF(PP )  +  SGRTF (F )  ,PP)  PRT0114C 

V<NC+1)=0.C  PRT01150 

U(NC )=OP/U(NC+ 1 )  PRT01160 

V(NC)=0.0  PRT01170 

FKRM  NEW  REDLiCeO  C0EFFICIENTS  PHT0I180 

7e  00  77  1  =  1. NC  PHTO  I  190 

77  H( I )=H( 1+2 )  PRT01200 

C0  T0  4  PRT01210 

ICO  RETURN  PRT01220 

aUD  PR  TO  1230 
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Minimization 

1.  SC00P   Linear  Surface  Minimization  -  FORTRAN  Coded 

2.  B0TM   Minimization  Routine  -  FORTRAN  Coded 

3.  MINI   Minimization  Routine  -  FORTRAN  Coded 

4.  MSR    Minimal  Surface  on  a  Rectangular  Mesh  - 

FORTRAN  Coded. 
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Identification:     SC00P  -  Linear  Surface  Minimization 

Routine  -  FORTRAN  II  Coded 
7090/9^ 
Purpose:   To  minimize  a  function  of  several  (l  to  24) 

parameters . 
Method:    A  simplified  description  of  the  minimization 
procedure  is  as  follows:   Tests  are  made  to 
determine  the  behavior  of  the  function  as  each 
parameter  is  varied  separately.   The  parameters 
are  then  all  varied  simultaneously  in  directions 
such  that  each  separately  would  decrease  the 
function.   The  last  best  values  are  written  out, 
and  the  entire  cycle  is  repeated. 
The  approach  to  the  minimum  is  made  via  a 
zig-zag  path.   Unlike  conventional  methods, 
which  go  down  the  steepest  linear  direction, 
gradients  are  never  computed.   Thus  the 
function  need  only  be  plecewlse  continuous. 
During  the  series  of  tests  at  the  beginning  of 
each  cycle,  the  individual  increments  are 
separately  adjusted.   The  routine,  therefore, 
retains  its  effectiveness  if  the  functional 
surface  is  steep  in  some  parameters  and  shallow 
in  others . 
Usage: [A]  Entry  to  SC00P  is  made  by  the  statement 

CALL  SC00P(N,X,D,F,SC,NC,LIM,IW,PUN) 
where 
N     Integer  equal  to  number  of  parameters 

(24  >  N  >  1)  . 
X     An  array  in  which  the  initial  values  of 
the  parameters  X(l) , . . . ,X(N)  should  be 
stored  before  entry  to  SC00P,  and  which 
contains  the  values  of  the  parameters 
corresponding  to  the  last  best  value 
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of  the  function  F  upon  return  from  SC00P . 
D     An  array  In  which  the  initial  values  of 
the  increments  D(l) , . . . ,D(N)  should  be 
stored  before  entry  to  SC00P,  and  which 
contains  the  current  values  of  the 
increments  upon  return  from  SC00P . 
X  and  D  must  appear  in  a  DIMENSH^N  state- 
ment with  dimensions  having  the  value  N  or 
greater . 
p     A  floating  point  variable  which  contains 

upon  return  from  SCjZ50P  the  last  best  value 
of  the  function.   It  need  not  be  defined 
before  entry  to  SC00P . 
SC,NC  A  convergence  criterion  for  SC00P .   If 
successive  best  values  of  the  function 
differ  from  each  other  by  less  than  the 
amount  SC  , f or  NC+1  consecutive  cycles, 
SC00P  is  terminated  (SC  >  0.,  NC  >  1  ). 
LIM   Integer  setting  an  upper  limit  to  the 
total  number  of  evaluations  of  the 
function  (10,000  >  LIM  >  1). 
IW    Integer  governing  output  (tape  6)  by 

SC^0P  according  to  the  following  table: 
=1  At  the  end  of  each  minimization  cycle 
(approximately  2N  evaluations  of  the 
function),  SC00P  will  write  the  total 
number  of  evaluations  of  the  function, 
the  last  best  value  of  the  function, 
and  the  corresponding  values  of  the 
parameters  (six  to  a  line) . 
=2  In  addition  to  the  above,  SC00P  will 
write  below  the  parameters  the  corres- 
ponding current  values  of  the  increment! 
=5  In  addition  to  the  above,  SC00P  will 
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write  below  the  increments  the  corres- 
ponding values  of  indicators  which  are 
sometimes  useful.   These  have  the  values 
+1,  0  or  -1  if  the  function  during  the 
last  series  of  tests  increased,  remained 
stationary,  or  decreased,  respectively, 
when  the  parameters  of  line  1  were 
varied  separately  by  the  increments 
of  line  2. 
FUN   The  name  of  the  FORTRAN  f^unction  which 

is  to  be  minimized.   This  name  must  appear 
in  Cols.  7-12  on  a  card  with  an  F  in  Col.  1 
in  the  program  calling  SC00P .   See  FORTRAN 
Reference  Manual  for  the  7090/94,  Form 
C28-6054, 

[B]  The  programmer  must  supply  a  FORTRAN  function 
of  the  form 

FUNCTI0N   FUN(X) 
which  computes  the  value  of  the  f'anction  from 
the  parameters  X(l) , . . . ,X(N)  and  stores  that 
value  in  FUN.   This  routine  is  called  repeatedly 
by  SC^0P,  which  sends  it  trial  sets  of  parameters 
and  receives  the  corresponding  functional  values. 
X  must  appear  in  a  DIMENSION  statement  in  this 
subroutine.   The  name  FUN  may  be  replaced  by  any 
other  floating  point  name  (not  ending  in  an  F  if 
it  contains  4  or  more  letters)  . 

[C]  The  minimization  routine  SC00P  terminates  and 
returns  to  the  calling  program  under  the  follow- 
ing circumstances: 

1.  The  convergence  criterion  of  SC,  NC  is 
satisfied.   This  condition  may  be  bypassed 
by  setting  SC  =  0. 

2.  The  total  number  of  evaluations  of  the  function 
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exceeds  the  limiting  value  LIM. 

3.  SC00P  tries  5  different  simultaneous 

variations  of  parameters  after  each  series 
■  of  tests.   If  4  such  consecutive  cycles 
fail  to  decrease  the  value  of  the  function, 
as  is  the  case  for  a  warped  functional 
surface  or  a  concave  but  non-decreasing 
linear  surface,  it  is  assumed  that  the 
function  is  at  a  minimum  with  respect  to 
the  current  increments. 

h.    The  smallness  of  the  increments  gives  a 
general  indication  of  the  extent  to  which 
the  function  has  been  minimized.   If  all 
the  increments  have  been  decreased  so  much 
that  they  produce  no  change  in  the  value 
of  the  function,  the  minimum  has  probably 
been  closely  approached. 

In  each  of  the  above  four  cases,  the  reason  for 

termination  is  clearly  written  out  by  SC^^/P  before 

returning  to  the  calling  program. 
[D]   Notes: 

1.  The  initial  values  of  the  increments  can  be 
positive  or  negative.   If  it  is  desired  to 
keep  one  or  more  parameters  constant,  the 
corresponding  D's  can  be  set  equal  to  zero 
(but  this  is  wasteful). 

2.  The  parameters  are  written  out  under  the 

•  FORMAT  F14.8,  so  they  should  remain  in  the 
range  |x|  <  1000. 
5.  The  time  used  by  SC^jZ^P  in  selecting  trial 
values  of  the  parameters  is  completely 
negligible  in  virtually  all  cases  in 
comparison  with  the  time  required  to 
evaluate  the  function. 


280 


4.  The  number  of  evaluations  necessary  to 
minimize  the  function  Increases  with  the 
number  of  parameters  and  the  severity  of 
the  grooves  in  the  functional  surface. 
Also,  as  might  be  expected,  it  varies 
somewhat  randomly  with  the  initial  values 
of  the  parameters  and  increments  (although 
SC(2f(2^P  tries  to  minimize  such  variations). 

5.  As  with  most  minimization  routines,  SC00P 
will  be  trapped  by  the  first  relative 
minimum  that  it  finds.   Therefore  one  or 
more  re-runs  with  SC^^P,  starting  with 
different  values  of  the  parameters  and 
Increments,  are  recommended  as  a  standard 
procedure  where  practicable.   This  procedure 
will  find  a  new  relative  minimum  point  or 
confirm  the  accuracy  to  which  the  original 
one  has  been  located. 

Test:     To  illustrate  the  capabilities  of  SC00P,  we 

report  a  test  run  with  a  comparatively  simple 
function  of  10  parameters 

^^ ,  ,    3,     IX4I+50IX  |+(|Xg|/50) 

p  =  ynqr  ixgx^i  +  e  ^       ^      ^       + 

+  X^/(Xg+l)  +  (X^-  X^q)^  . 

The  minimum  value  of  this  function  is  obviously  1. 
The  starting  values  of  the  parameters  and 
increments  were  arbitrarily  chosen  as 

(X^  to  X^)  =  1.   (Xg  to  X^q)  =  2.  (D^to  D^q)=.2 
The  initial  value  of  P  and  Its  value  after  a 
number  of  trial  evaluations  of  the  function  by 
SC^^P  is  given  below: 
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No.  of 
Cycles 

0 

No.  of 
Evaluations 

0 

F  Value 
1.4  X  10^^ 

4 

56 

1.05 

9 

124 

1.003 

17 
22 

229 
291 

1.00007 
1.0000006 

29 

378 

1.00000001 

The  number  of  evaluations  in  the  second  column 
includes  the  10  test  evaluations  per  cycle 
(see  "Method" ) . 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
The  routine  uses  the  subroutines  necessary  to 
write  an  output  tape.   These  routines  are 
discussed  more  fully  in  the  last  section  of 
this  report. 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  XMAXO,  XMINO 

c)  Storage 

727^Q  =  13270  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:    Melvin  Sobol 
Date:      July  I963 
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X    //43XI3.11H  PARAVETERS   CXSHLIO'   =Ib/44X4H 

X  ///////54XMHINI  TIAL  VALLfTS   ) 

FIRST  CALL  0F  FLN  «ITH  INITIAL  VALUES  KF 

NTEST=0 

L  =  0 

NC0LNT=O 

VI=FUN (XREST ) 

F  =  VI 

WHITE  0LTPLT  TAPE  6 , 4 1  ,L , F , ( XKE S T ( I  )  .  I  =  1  ,  N 

4  1 

F^)H^'AT(  IXia.  ll-.3XiiHF  =  ei6.9,3xeF14.8/32X6Fl 

OcGINNING  0F  MINIMIZATieN  CYCLE. 

1 

iF(L+N-LiM)e.eo.eo 

a 

C0  25  1=1. N 

2S 

X(  I  )=XBEST(  I  ) 

SCa0P  -  LINEAR  SLRFACE  MMMZATIgN  RBLTINE  -  F0RTHAK   II  C0CEO 

CSCK0P       LINEAR  SLRFACE  MNIMIZATIZN  SeUTINE      KELVIN  SeB0L.    NYU      SC0t)POOl 

SueR0UTINE  SC00P  (N,  XBEST  .0  ,F  .SC  ,NC  .LI**.  I«  ,FLN  >  SC0aPOO2 

C  FUN  IS  NAME  0F  F0RTRAN  FLNCTI0N.  SC00POO3 

C  CALLING  PR0GRAM  REQUIRES  F-CARC.  SC00POO4 

DIMENSIBN  XQE^T( 24 )  .0(24  )  ,X(24  )  ,K  (24 )  SC00POO5 

IKRITE  0UTPLT  TAPE  6  ,  4  0  .  N  ,  L  I  K  .  S  C,  NC  SCeaPOOe 

40     F0RMAT(  II-135X50H-  SCBilP  -       LINEAR  SLRFACE  >*  I  N  I  y  1  Z  AT  I  0N  RauTINE  SC00POO7 

SC  =1PE12.4.8X4I-NC  =  13  SC00PCO8 

SC00POOq 

X  ANC  C.  SC00POIO 

SC00POI 1 

SC00PO12 

sceepo  13 

SC00POIA 

SC00PO15 

)  SC00PO16 

4.8/34X6F14.8/3eX6F14.e )SC00PO17 

sc00POie 
sceapoig 
sc0aPO2O 

SC?0PO21 

C          XBEST(I)  ARE  LAST  BEST  VALLES  gF  PAfiAMETEfiS.  SC00POZ2 

C          TEST  FUNCTI0N  K  TIMES  BY  INCREASING  PARAMETERS  SEPARATELY  EY  SC00PO23 

C          AM0UNTS  0(1).      THEN  ReST0RE  ALL  X(I)   T0  eRIGINAL  VALUES.  SC00PO24 

C          SET  INDICAT0RS  M(I)  =  -I.  0.  0R  1.  SC00PO25 

10     D0  30  1=1, N  SC0HPC2e 

X( I )=XBEST ( I )+0( I )  SC00PO27 

M(  I )  =  i  sc0apo2e 

L=L*1  SC00PO29 

IF(FUN( X  )-vI  )20.2.30  SC00PO3O 

2      M(  I  )=0  SC00PO31 

G0  T0  30  SC00PC32 

20     M(  I  )=-  1  SC00PO33 

30     X(  I  )=XUEST(  I  )  SC00PO34 

C          M(l)=-1   IF  FUNCTI0N  DECREASED  ...  0(1)  REMAINS  UNCKANGEC.      SC00PC3E 

C          M=0.»1   IF  FLN.  STATI UNARY. INCREASED. . .  C  eEC0MES  -2/ 1     C.       SC00PO36 

C          WRITE  0UT  D  AND  M  VALUES  IF  DESIRED.  SC00PO37 

IF( I»-2 )81 .82,32  SC00PO3e 

82  WRITE  euTPLT  TAPE  6 , 42 , ( D ( I ) . I = 1 . N )  SC00PO39 

42  FURMAT(13X14HINCREMENTS  ...3XeF14.e/32X6F14.b/34X6F14.8/3ex6F14.e)SC0aPO4C 
IF(  IW-2 )Q1  ,81 .83  SC00PO41 

83  WRITE  KUTPLT  TAPE  6 , 4 3  ,  ( V (  I  )  . I  =  1  . N )  SC00PO42 

43  F0RMAT(  1  3X  14l-INniCAT0RS  .  .  .  3  Xf  {  3  X  I  2  .  1  h  .  8  X  ) /32  X6  (  3X  I  2  .  1  H  .  8  X  )  /         SC00PO43 
X  34Xe( 3X 12, 1H.8X)/36X6( 3X12, 1H.8X ) )  SC00PO44 

01     WRITE  0UTPUT  TAPE  6,48  SCe0PO«5 

48     FaRWATI   /  )  SC00PO*t 

0F  PARAMETERS  ACCRRCING  ^9     TESTS  Ae0VE.         SC00PO47 

sc00PO*e 
sceaPOAq 

SC00PO5O 
SC00PO51 
SC00PO52 
SC00PO53 

sc00Poe4 
scfl0Po;5 


FIRST 

SIMLLT. 

00  21   I 

=  1.N 

IF(M( I ) )31 .3,3 

X( I )=X( 

I  )  tO(  I  ) 

X(  I  )=X( 

I  )+D(  I  ) 

L=L*  1 

VF=FUN( 

X  ) 

IF  t VF-V 

I  )4,5,S 
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SCC0P  -  LINEAR  SLRFACE  ^'IMfI2*TI0^  RBUTINE  -  F0RTRAN  II  C0CEO 

V1=VF  SC00POSe 

FUNCTI0N   IN  C0NTINLALLY  DECREASING  F^ASE.                               SC00PO57 

on     32  1=1. N  SC00PO5e 

xeesTC  I  )=x(  I  )  SC00PO59 

c(  I  )  =  t  .2*c(  I  )  sc00Poeo 

ALL   INCREMENTS  G0  LP  BY  FACTKR  1.2  EACH  TIKE  FUNCTIgN  GeES  C  8 1«N .  SC  00PO4  1 

X( I )=X( I )+C( I )  SCa0PO62 

NTdST=C  SC00PO63 

IF  (L-LIM )2 1 .22.22  SCflBPOe* 

L=L*1  SC00POe5 

VF  =  FLIN(X)  SC00PO6e 

IF(VF-VI)  4.15.15  SC00PO67 

FUNCTION  CEASES  T0  DECREASE.    TEST  F BR  CeKVEBGENCE.                  SC00PO6e 

iFCAasFtF-vn-soiq.ie.ie  sc00po6<3 

NC0LNT=NC0LNT+1  SC00PO7O 

1F(NC0LNT-NC )22.63.e3  SC00PO71 

NC0LNT=O  SC00PO72 

WRITE  LAST  BEST  VALUES.    RECYCLE.  SC00PO73 

F=VI  SC00PO74 

*HITe  aUTPUT  TAPE  e, Al  .L.F  ,  ( XEEST ( I  )  ,  1  =  1  .N )  SC00PO7S 

G0  T0   1  SC00PO7e 

FUN.  O0ES  N0T  DECREASE  LNOES  FIRST  SIMULT.  VAR.  0F  PAR.             SC00PO77 

FIND  MINIMLV  AND  MAXIML^'  VALUES  eF  ISDICATBRS.                        SC00PO78 

MIN=1  SC00PO79 

00  37  1=1. N  SC00PO8O 

MIN=XM INOF (MIN,M( I ) )  SC00PO81 

^lAX:-!  SC00PO82 

Da  38  1=1. N  SC00POe3 

MAX=Xr'AXOF  (MAX.M(  I  )  )  SC00POaA 

IF{MAX  )e .6. 10  SCB0POe5 

S0M6  M  =  tl.KEEP  SLIDING  De*N  LIN.  SURF.  »ITI-  PAR.S  C  0RRe  S  .M  =  0  .  ♦  I  .  SC  00POee 

00  33  1=1, N  SC00PO87 

IF(M(I   ))33,7,7  SC00PO8e 

X( I )=X( I )+C( I )  SC00PO89 

C0NTINUE  SC00PC9O 

L=L+l  SC00PO91 

VS=FUN(X)  SC00PC92 

IF( VS-VI ) 14. 1 1. 1 1  SC00PO93 

VI=VS  SC00PO9A 

G0  T0  54  SC00PO9E 

FUN.  O0ES  N0T  DECREASE  UNDER  SECCND  SIKULT.  VAR.  eF.  FAR.  SC00PC9e 

IF(M  IN  )  12.80. eO  SC00PO97 

S0ME   M=-1.TRY   THIRD   SIMULT.   VAR.   eF   PAR.   »  I  T  t-  M=-l   PAR.S   0NLY.    SC00PC9e 

F0R  M=0.+1  PAR.  REST0RE  X  T?  0RIG.VAL.  AND  KAKE  D=-l/3  HR I C . V AL .SC 00PO99 

00  35  1=1. N  SC00P1OO 

IF(M(  I  )  ) 35 . I  7,  17  SC00P1O1 

X(  I  )=XBEST(  I  )  SC00P1O2 

D( I )=.5»0( I )  SC00P1O3 

C0NTINUE  SC00P1O4 

L=L+1  SC00PIO5 

VT=FUN(X)  SC00PIO6 

1F( VT-VI  )74,7C,70  SC00P1O7 

VI=VT  SC00PlOe 

G0  T0  54  SC00P1O9 

ALL  M=C,*1.  MAKE  ALL  D=-l/3  BRIG.  VALUE.  SC00P11O 
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LINEAR  SLRFACe  VI 


IflZAt leh     ReCTIKE 


FBPTRAN   It  C0CEC 


on     36  1=1. N 

C(  I  )  =  .S»C(  I  ) 

ALL  M=0.*1.  LINEAR 
BLT  N0N-CeCREASING 

NTtST=NTESTtl 


SC00PI  I  I 

SCBBPI  12 

iURFACE  eF  FLN.  CETERMNEC  T0  BE  CBNCAVE  UP   SC00P113 

•  ITH  RESt-ECT  T0  CURRENT   INCREMENTS.  SC00P114 

SC00P1 15 


NTEST=     N0.     aP     C0NSECUTI\/E 

THY  TESTS  AND  SIMULT.  VAR, 
WRITE  0UTPLT  TAPE  6.06 


•eN-DECRE ASING/ 
eF  PAR.  AGAIN 


<ARPEC  LINEAR  SURF  ACES .SC 00P 1  1 6 
SC00P1 17 

iITH  NEW  SMALLER  C  VAL.SC00Plie 
SC00P1 19 


F0RMAT(«lh  C0NCAVE  LINEAR  SURFACE   IS  N ZN-CECRE AS  I NG 
X  5i?l-  -       SC0aP  KILL  TRY  AGAIN  WITH  SMALLER  INCREMENTS 
GH  T0   1 
WRITE  0UTPUT  TAPE  6 , I « 2 


SC00P12O 
SC00P121 
SC00P122 
SC00Pt23 


FHRMAT(53H  A  N0N-DECREASING  LINEAR  SURFACE  HAS  SEEN  ENCBUNTEREC     SC0BPI24 

<    £2h  A  TIMES  IN  SUCCESSieN  )  SC00P125 

WRITE  0UTPLT  TAPE  6,1AA  SC00P12e 

F0RMAT( /eHOFLNCT I0N  AT  MINIMLN  WITH  RESPECT  T0  CURRENT   INCREMENTS  SCBBP127 


DECREASED  IN  APPRBACH  Te  MIMMU> 


X-       SC00P  TERMINATED  ///, 
G0  Ta  50 
IFCMIN  )70.g5.95 

ALL  M=C.   INCREMENTS  FULL' 
WRITE  HUTPUT  TAPE  6.143 

F0RMAT  (<t2HCINCHEMENTS  T00  SMALL  TE  DECREASE  FUNCTI0N/ 
X59H  MINIMUM  PRUHADLY  CL0SELY  APPRgACHEC  -       SCBBP  TERMINATED 
X////   ) 
G0  T0  £0 

NU  M=+l.  SeME  M=-l.  FIRST  SIMULT.  VAR.  HAS  FAILED. 

-0R-  SUME  M=+l.  SBMF  M=-I.   THIRC  SIMULT.  VAfi.  HAS  FAILEC. 
NTEST=NTEST+1 
IF(NTCST-4 ) 71 .96.96 

LINEAR  SURFACE  0F  FUNCTIBN  CETESMINED  T0  BE  WARPEC. 

MULTIPLY  D  av  -1/2  F 0R  ALL  FAR.  CBRBES.TB  M  =  -l.  RETEST  FUNC T  I  0N . SC 0BP 1 42 
D0  73  1=1. N  SC00P143 

IF(M( I ) )72.73.73 
C{  I  )=-.5»0(  I  ) 
C0NT INUE 

WHITE  0UTPUT  TAPE  6.141 

FHRMAT(78H  WARPED  FUNCTI0NAL  SURFACE  -       SCBBP  WILL  TRY  AG/ 
XTH  SMALLER  INCREMENTS    ) 
G0  T0  1 

WRITE  UUTPUT  TAPE  6.47 

F0RMAT ( /// J7H  LIMIT  RtACHEO  -       SCBBP  TERMINATED  //// ) 
G0  T0  50 


sc00Pi2e 

SC00P129 
SC00P13O 
SC00P131 
SC0BP132 
SC00P133 
SC0BP134 
SC00P135 
SC00P136 
SC00P137 

sc00Pi3e 

SC00PI3? 
SC00P14C 
SC00P141 


F  =  VI 

WRITE  0UTPUT  TAPE  6 . 4 1  .L  .  F  .  ( xe ES T (  I  ) 
WHITE  0UTPUT  TAPE  6.147 

F0RMAT(///55H  C0NVERGENCE  CRITERIKN  ! 
XEO  ////   ) 
RETURN 
END 


SC00Pt44 
SCB0PI4! 
SC00PI4e 
SCe0PI47 

M  wisc00Pi4e 

SCB0P149 
SC00P15O 
SC00P151 
SC00P152 
SC00P153 
SC00P154 
SCBBPISS 
SC00P156 
INATSC00P157 
SCBBPISe 
SCB0P159 
SCfl0P16O 
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Identification:     B0TM  -  Minimization  Routine 

FORTRAN  II  Coded 

Purpose:   This  subroutine  finds  the  minimum  of  a  function 
of  several  variables.   It  requires  no  derivative 
evaluations.   The  user  must  provide  a  SUBR0'UTINE 
subprogram  to  evaluate  the  function  for  values 
of  the  independent  variables. 

Method:    See  M.  J.  D.  Powell,  "An  efficient  method  for 
finding  the  minimum  of  a  function  of  several 
variables  without  calculating  derivatives," 
Computer  Journal,  Vol.  7,    July  196k,   pp.  I55-I62, 

A  distilled  version  follov;s. 

Each  iteration  of  the  procedure  starts  with  a 
search  down  n  linearly  Independent  directions 
ii ,^2' • ■ • '^      starting  from  the  best  known 
approximation  p^  to  the  minimum.   These 
directions  are  chosen  to  be  the  coordinate 
directions  initially,  so  the  start  of  the  first 
iteration  is  identical  to  an  iteration  of  the 
method  which  changes  one  parameter  at  a  time. 
The  latter  method  is  modified  to  generate 
conjugate  directions  by  making  each  iteration 
define  a  new  direction  i   and  choosing  the 
linearly  Independent  directions  for  the  next 
iteration  to  be  i^, . . . ,i^,i.      More  specifically 
the  basic  procedure  is  as  follows: 

1)  find  A30  which  minimizes  f(p^_2_+  \^r'' 

2)  set  p^  =  p^_-^  +  Ts^i^ 

3)  repeat  from  1)  for  r  =  l,...,n 

4)  set  i^   =  i^_^^,    V   =   l,...,n 

5)  set  e^  -   P^-  Po 

6)  find  A  which  minimizes  f(Pj^+  ^(P^"  Pq^^ 

7)  set  Pq  =  Pn  +  ^^Pn"  ^0^ 

The  manner  in  which  |  is  defined  insures  that. 
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If  a  quadratic  is  being  minimized,  after  k 
iterations  the  last  k  of  the  n  directions 
chosen  for  the  (k+l)_st  iteration  are  mutually 
conjugate,  and  that  the  exact  minimum  of  a 
quadratic  will  be  found  after  n  iterations. 
The  basic  procedure  is  modified  to  Insure  that 
the  rate  of  convergence  to  the  minimum  is 
satisfactory,  even  when  the  initial  approximation 
is  very  poor.   Such  a  change  has  to  be  made  when 
the  basic  procedure  chooses  nearly  dependent 
directions.   This  possibility  has  been  found 
to  be  serious  if  the  function  to  be  minimized 
depends  on  more  than  five  variables.   The  modifi- 
cation allows  a  direction  other  than  |,  to  be 
discarded,  so  that  the  new  direction  will  always 
contain  an  appreciable  component  of  that  which 
is  lost.   Sometimes,  it  is  altogether  unwise  to 
replace  any  of  the  |.,...,^   by  4 .  so  the  modifi- 
cation also  allows  the  old  set  of  linearly 
independent  directions  to  be  used  again.   More 
specifically,  the  modified  procedure  is  as  follows; 

1)  find  A  which  minimizes  f(p  _-|+  A  |  ) 

2)  set  p^  =  p^_^+  A^e^ 

3)  repeat  from  1)  for  r  =  l,...,n 

4)  find  m,  1  j<  m  _<  n  which  maximizes  f(p   ,  )-f(p  ) 

5)  set  A  =  ^(Pm-l^-^^Pj 

6)  set  f^  =    f(pQ),   fg  =  f(p^),   f^  =  f(2p^-pQ) 

7)  if  f^  >  f;^  and/or  (f^-  2f2+  i^j,)(i^i-   fg"  ^^^ 
>  ^  A(f^-  f-,)^  proceed  to  step  8); 
otherwise,  proceed  to  step  9) . 

8)  use  the  old  directions  i-,,...,i      for  the 
next  iteration  and  use  p   for  the  next  p^^, 
repeat  from  1) 

9)  find  A  which  minimizes  f(p^+  ^(P^"  Pq^^ 
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10)  set  I   =  ^  ,n  for  r  =  m, ...,n-l 

11)  set  e^  =  Pn  -  Po 

12)  set  Pr,  =  P   +  ^(P   -  Po) 

The  disadvantage  in  the  above  modification  is 

that  one  of  the  mutually  conjugate  directions 

may  be  thrown  away,  so  that  more  than  n  iterations 

would  be  required  to  find  the  exact  minimum  of  a 

quadratic . 

Quadratic  interpolation  is  used  to  find  the 

minimum  in  a  given  direction. 
Usage:     The  routine  is  entered  by 

CALL  B0TM(X,E,N,EF,ESCALE,IPRINT,IC0N, 
MAXIT^CALCPX^W) 

where 

N      must  be  set  to  the  number  of  variables. 

X,E    are  to  be  one-dimensional  arrays.   On 

entry  to  the  routine  X(l)  must  be  set  to 
an  approximation  to  the  I   variable 
and  E(I)  to  the  absolute  accuracy  which 
X(I)  should  have  at  the  calculated  minimum, 
On  exit  X(I)  will  be  set  to  the  calculated 
value  of  the  I  '  variable  at  the  minimum. 
It  is  assumed  that  the  magnitudes  of  the 
parameters  E(I)  are  approximately  propor- 
tional to  the  magnitudes  of  the  corresponding 
variables  X(I) . 

EP     will  be  set  to  the  minimum  value  of  the 
function . 

ESCALE  limits  the  maximum  change  in  the  independent 
variables  at  a  single  step.   X(I)  will  not 
be  incremented  by  more  than  ESCALE  x  E(I). 

IPRINT  controls  printing.   If  it  is  set  to  zero 

there  will  be  no  printing.   If  IPRINT  =  1, 
the  variables  and  the  function  will  be 
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printed  after  every  search  along  a 
direction.   If  IPRINT  -  2,  they  will  be 
printed  after  every  Iteration,  which 
consists  of  N+1  searches  In  N+1  directions. 
IC0N  must  be  set  to  1  or  2.   It  controls  the 

convergence  criterion  (see  below) . 
MAXIT  Is  the  absolute  upper  bound  on  the  number 
of  Iterations  the  routine  will  perform 
before   exiting. 
SUBROUTINE  CALCPX(N,X,F)  must  be  provided  by  the 
user.   N  Is  the  number  of  variables; 
X(l) ,X(2) , . . . ,X(N)  are  the  current  values 
of  the  variables;  It  must  set  F  to  the 
corresponding  value  of  the  function  to  be 
minimized . 
W     Is  to  be  a  one-dimensional  array  of  length 

_>  N(N+3)  .   It  will  be  used  as  a  working  area 
The  arrays  X,  E  and  W  have  been  dimensioned  as 
X(l),  E(l),  W(l);  hence  the  DIiy[ENSI0N  statement 
in  SUBR0UTINE  B0TM  need  not  be  changed  to  match 
the  dimensions  of  X,  E,  W  in  the  user's  calling 
program. 
The  Convergence  Criterion: 

This  will  normally  be  satisfactory  if  IC0N  is 
set  to  one.   However,  if  better  accuracy  is 
required  or  if  It  is  suspected  that  the  required 
accuracy  is  not  being  achieved,  IC0N  should  be 
set  to  two  and  a  more  thorough  check  on  the 
convergence  will  be  made  at  the  expense  of 
increasing  the  execution  time  by  maybe  as  much 
as  30  per  cent.   With  IC0N=1  convergence  will  be 
assumed  when  an  iteration  changes  each  variable 
by  less  than  10  per  cent  of  the  required  accuracy; 
with  IC0N=2  such  a  point  is  found  and  It  Is  then 
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displaced  by  ten  times  the  required  accuracy  in 
each  variable.   Minimization  Is  continued  from 
the  new  point  until  a  change  of  less  than  10  per 
cent  is  again  made  by  an  Iteration.   The  two 
estimates  of  the  minimum  are  then  compared. 

Output:    Apart  from  the  output  controlled  by  IPRINT, 

there  will  be  some  relevant  printing  if  it  is 
believed  that  the  required  minimum  has  not 
been  found  to  the  required  accuracy. 

Recommendations : 

1)  Determine  the  maximum  step  ESCALE*E(I)  such  that 
the  search  procedure  will  not  skip  from  one 
"valley"  to  another.   Then  set  the  required 
accuracy  E(I)  such  that  ESCALE  is  at  least  one 
hundred . 
11)  If  the  answers  appear  to  be  unreasonable,  try 
different  Initial  values  of  the  variables  X(l) . 
ill)  This  routine  will  need  1429.q  =  '^^'^^Q   locations 
if  it  is  recompiled  with  the  rounding  option, 
i.e.  the  *  R^ZfUND  card. 

Comparison: 

1)  a  function  with  a  steep-sided  helical  valley 

f(x-j_,x,2,x^)  =  100{[x^-10  0(x^,X2)]^+ 
+  [r(x-^,X2)-l]^}  +  x| 

27rO(x-,,Xp)   =   arctan  (x^/y:-^)  ,  x^  >  0 

arctan  (Xp/x-,  )+7r,    x.  <  0 

r  ^      /  2  ,   2^l/2 

r(x^,X2)   =   (x^  +  Xp) 

SC^0P  used  5321  function  evaluations. 
B0TM  used  227  function  evaluations. 

2)  function  with  a  deep  parabolic  valley 
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SC^^ZfP  used  2367  function  evaluations. 
B0TM  used  I5I  function  evaluations. 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

The  routine  also  uses  the  subroutines  necessary 
to  write  an  output  tape.  These  routines  are 
discussed  more  fully  in  the  last  section  of 
this  report. 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  MAXl,  MINI,  SIGN 

c)  Storage 

1307;]_Q  =  2453g  locations  plus  the  required 
subroutines  listed  In  a) . 

Author:    Eva  V.  Swenson 

(Modified  version  of  VAO^A  by  M.  J.  D.  Powell 
of  the  Atomic  Energy  Research  Establishment, 
Harwell,  Dldcot,  Berkshire,  England.) 

Date:      September  1964 
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BdTM  -  MINIMIZATI0N  R0CTINE  -  FBRTRAN  II  CBDEO 


CB0TM  AN  EFFICIENT  METHaO  FgR  FINDING  THE  H'lMMUM  BF  A  FUNCTI0N  BBTMOOIO 

C       0F  SEVERAL  VARIABLES  WITH0LT  CALCLLATING  DERIVATIVES.    ADAPTED  B0TMOO2O 

C           FR0M  SLERaoTINe  VA04A  OY  MJD  P0«rELL.  HABwELL,  ENGLAND.  B0TMOO3O 

C       .THIS  SUBR0UTINE  IS  SERIALIZED  FRKV  B0TMOO1O  TK  e0Tf'28SO BBTMOOAO 

SUBRauTINE  B0TM(X.E.N,EF,ESCALE.IPHINT,ICaN.^AXIT.CALCFX.*)  B0TMOO5O 

C  BBTMOOeO 

C           X    IS  A  BNE-DIfENSIBNAL  ARRAY  eF  INDEPENDENT  VARIABLES  B0TMOOTO 

C           E{I)    SPECIFIES  THE  ABS0LUTE  ACCURACY  T0  ImHICH  THE  0PTIMUK  BBTM0080 

C              VALUE  0F    X(I)    IS  REQUIRED  B0TMOO9O 

C           N    IS  THE  NUMBER  0F  VARIABLES  BOTMOIOO 

C           EF   WILL  BE  SET  T0  THE  MINIMUM  VALUE  0F  THE  FUNCT I 0N  B0TMOI1O 

C  ESCALE   LIMITS  THE  MAXIMUM  CHANGE  IN  THE  VARIABLES  AT  A  SINGLE  B0TMO12O 

C  STEP.    X(I)    WILL  N0T  BE  CHANGED  BY  M0RE  THAN   ESCALE«e(I)     B0TMO13O 

C           IPRINT  =  0   N0  PRINTING  B0TMOIAO 

C  =   1    FUNCTI0N  AND  VARIABLES  WILL  BE  PRINTED  AFTER  EVERY  B0TMO15O 

C                           SEARCH  AL0NG  A  LINE  B0TMO16O 

C  =2   FUNCTI0N  AND  VARIABLES  WILL  BE  PRINTED  AFTER  EVERY  B0TMO17O 

C                           ITEHATI0N,   I.E.   (N+l)  SEARCHES  AL0NG  A  LINE  BBTM0180 

C           IC0N   C0NTR0LS  C0NVERGENCE  CRIIERIBN  —   SEE  WRITE-UP  B0TMO19O 

C           R0UTINE  WILL  BE  LEFT  AFTER   MAXIT    ITERATI0NS  HAVE  BEEN  B0TMO2OO 

C              C0MPLETED  B0TMO21O 

C  CALCFX    IS  THE  NAME  0F  THE  SUBB0UTINE  PR0VIDED  BY  THE  USER  WITH80TMO22O 

C  ARGUMENTS   CALCFX{N, X .F ) .    IT  MUST  C0MPUTE  THE  VALUE  0F  THE   B0TMO23O 

C              FUNCTI0N  T0  BE  MINIMIZED,  GIVEN  THE  CURRENT  VALUES  0F  THE  X-SB0TMO2AO 

C              AND  STBRE  IT  IN   F.  B0TMO25O 

C           W    IS  A  BNE-DIMENSI 0NAL  ARRAY  0F  LENGHT  AT  LEAST   N»(N+3).  IT  B0TMO26O 

C              WILL  BE  USED  AS  INTERMEDIATE  ST0RAGE  BY   e0TM.  8aTM0270 

C  B0TMO28O 

DIMENSI0N  W( 1 ) ,X( I ) ,E( 1 )  B0TMO29O 

F       CALCFX  B0TMO3OO 

DOMAG=0. I'ESCALE  BBTM0310 

SCER=0.05/ESCALE  B0TMO32O 

JJ=N»(N+1)  B0TMO33O 

JJJ=JJ+N  B0TMO34C 

K=N*1  B0TMO3SO 

NFCC=1  BBTM0360 

IND=1  BBTM0370 

INN=I  BBTM03eO 

D0  4  1=1. N  B0TMO39O 

W(I)=ESCALE  B0TMO4OO 

D0  4  J=1.N  BBTM0410 

W(K)=0.  BBTM0420 

IF(l-J)4,3,4  B0TMO43O 

3  W(K  )=ARSF(E(  I  )  )  B0TMO44C 

4  K=Ktl  B0TMO45O 
ITERC=1  B0TMO46O 
ISGRAD=2  B0TMO47O 
CALL  CALCFXCN. X,F )  80TMO48O 
FKEEP=2.»ABSF(F>  B0TMO49O 

5  IT0NE=1  B0TMO5OO 
FP=F  B0TMO51O 
SUM=0.  BBTM0520 


BaTM0530 
B0TMO54C 
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IXP=IXPtl  BaTMOSSO 

w(  IXP)=X(  I  )  BaTMC560 

IDIRN=N+1  B0TMO57O 

ILINE=1  B0TyO58O 

7  CMAX  =  W(  ILINE  )  80TMO59C 

CACC=DMAX»SCeR  B0TMO6OO 

OMAG  =  MIMF  (CCMAG.O.  I«CVAX)  B0TMO61O 

0MAC=MAXIF(CWAG.20.«DACC)  B0rMO62O 

CD^'AX=  10.•C^'AG  B0TMO63O 

G0  T0  ( 70.  70. 71  )  ,  I T0NC  B0TMO64C 

70  DL=C.  B0TMO65O 

C=CNAG  B0TMO66O 

FPREV=F  B0rMO67O 

IS=£  B0TMO6aO 

FA=FPREV  B0TMO69O 

CA=CL  B0TMO7OO 

ti     CD=C-CL  B0TMO71O 

CL=C  B0TMO72O 

B0TMO73O 

B0TMO74O 

(K)  8aTM0750 

B0TMO76O 

<,F)  B0TMO77O 

B0TMO78O 

2.  13.  M. 96)  .  IS  B0TMO79O 

?4  B0TMO8OO 

\X )   17. 1 7, le  D0TMOaiO 

B0TWOe2O 

B0TVOe3O 

»PE  6,19  B0TMO84C 

<IMOM  CHANGE  D0ES  NZT  ALTER  FtNCTIKM  B0TMOeSO 

G0  T0  20  H0TMOe6O 

Fe=F  B0rvoe7O 

CD=C  B0TMOe8C 

G0  Ta  21  B0TMO89O 

FU=FA  B0TMO9OO 

CB=CA  H0TMOS1O 

FA=F  B0TMC92O 

OA=C  801^0930 

G0  T0  ( 83. 23 ) ,  ISGHAC  B0TMO94C 

C=Ce+Ce-DA  B0TMO95O 

IS=1  B0TMO96O 

G0  T0  8  O0TMO97O 

C=0.5»(CA*CQ-(FA-Fe)/(DA-CB))  B0TMC98O 

IS=4  P0TMO99C 

IF ( (DA-C )• (0-CH) )25 .e.e  B0IM1COO 

Ib=l  B0TM1O1O 

IF(AesF(C-Ce)-CDf'AX)e.H.2fc  B0TM1O2O 

D  =  Ce  +  SIGNF(DCN'AX.CH-OA  )  H0rMlO3O 

IS=1  B0IMIOAC 

CDMAX  =  CD>'AX+CCMAX  B0TMIO5O 

ODMAG^CCWACtCCMAG  B0TM1O6O 

IF(rcMAx-c^'Ax  )e,e.27  b0tmio7o 

CDMAX=CMAX  B0TM1O8O 

CU     T0  H  B0TM1O9O 


K=IDI 

RN 

00  9 

1  =  1  .N 

X(  I  )  = 

X( I )+C0« 

K=K*  1 

CALL 

CALCFXIN 

NFCC  = 

NFCCt  1 

G0  Ta 

(10.11. 

IF(F- 

FA)  15.  le 

IF  (ABSF(C)-CI 

C  =  C-»D 

G0  Ta 

e 

WRITE 

0LTPLT 

F0RMA 

TCsxaeHN- 
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13  IF«F-FA)2e.23.23  B0TMtlOO 

£6  FC=FB  BaTMlllO 

DC=CB  BBTMllZO 

29  FB=F  B0TM113O 
CB=C  B0rMll4O 
G0  T0  30  B0TMI15O 

12  IF(F-Fe)28.2e.3t  B0TM116O 

31  FA=F  80TMI17O 
DA=C  B0TMIieO 
G0  T0  30  B0TM119O 

11  IF(F-FB)32, 10. 10  B0TM12OO 

32  FA=Fe  B0TMI21O 
DA=CB  B0TM122O 
G0  Ta  29  B0TM123O 

71  CL=l.  B0TMt24O 

CDMAX=5.  B0TM125O 

FA=FP  B0TM126O 

0A=-1.  B0TMJ27O 

FB  =  FI-0LD  B0TM128O 

DB=0.  B0TM129O 

C=l.  B0TM13OO 

10  FC=F  B0TM131O 

CC=C  B0TM132O 

30  A=(C6-CC)«(FA-FC)  B0TM133O 
B=(CC-DA)»(FB-FC)  B0TMt34C 
IF( (A +6) •(DA-DC) ) 3 3, 33. 34  B0TM13SO 

33  FA=F8  B0TM136O 
OA=CB  B0TM137O 
FB=FC  B0TM138O 
OB=CC  B0TM139O 
G0  T0  26  B0TM14OO 

34  0=0.5»( A«(CB+DC)*B»(OA+OC ) )/( A+B)  B0TM14IO 
OI=CB  B0TM142O 
FI=FB  B0TM143O 
IF(F6-FC )44,44.43  B0TM144O 

43  OI=CC  B0TM145O 
FI=FC  B0TMI46O 

44  G0  T0  (86.86.85) . IT0NE  B0TM147O 
£5  IT0NE=2  B0TM148O 

G0  T0  45  B0TM149O 

66  IF  ( A8SF(0-0I )-OACC)  41.41.93  B0TM1SOO 

93  IF  ( ABSF(C-DI )-0.03«A8SF(C) >  41.41.4S  B0TM151O 

45  IF  (  (DA-DC  )»(0C-0)  )  47.46.46  B0TM152O 

46  FA=FB  B0TM1S3O 
DA=DB  B0TM1S4C 
FB=FC  B0TM1SSO 
DB=DC  B0TM156O 
G0  T0  25  B0TM157O 

47  IS=2  B0TMl5eO 
IF  ( tOe-0)«(D-OC) )  48.8.8  B0TMI59O 

48  IS=3  B0TM16OO 
G0  T0  8  B0TM16IO 

41  F=FI  B0TM162O 

D=DI-DL  B0TM163O 

DO=SQRTF( (CC-OB)«(OC-OA)»(DA-DB)/(A+B) )  B0TM164O 
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B0TM    -     NINI^'I /ATI  0N     FIBLTINE     -    FeBTR*N     II     CBOEO 

D0  *9  1=1. N  BBTMieSO 

X( I )=X( I )*0»»< IDIRN)  B0TMI66O 

W(  ICIflN)=CD»*l(  IDIRN)                                     _  BBTM1670 

i»9   ioiBN=  IDIRN+ 1                              '  eaTMieeo 

W(  ILINE)=*(  ILINe)/DO  BflrM1690 

ILINe=ILIKe*l  BBTMITOO 

1F( IPRINT- 1 )5l .50.51  B0TM171O 

50     WHITE  BUTPLT  TAPE  6 . 52 . I TERC . NFCC .F , ( X (  I  )  . I  =  1 , N )  B0IM172O 

5?     F0RI«lATt/lCH  ITERATI0NIS.I  IS.ieH  FCNCTieN  VALUES  .  I  0X3MF  =E  1  5.  8/ (  2X8BB  TM  I  7  30 

XEie.e))  BBTM1740 

G0  T0( 5 1 .53) . IPRINT  BeTM1750 

51  G0  T0  (55.38) , IT0NE  BaTMl760 

55  IF  (FPREV-F-StM)  90,95.95  B0TM1770 

95  SUM=FPREV-F  BeTM1780 
JIL=ILINe  BBTM1790 

94  IF  (ICIRN-JJ)  7.7, a«  BBTMieOO 

fc4  G0  Tfl  (92.7?).  INC  BBTM18I0 

92  FH0LO=F  BflTM1820 

IS=6  BBTM1830 

IXP=JJ  BaTMl84C 

D0  59  1=1. N  BBTMIBSO 

IXP=IXP+1  BBTM1860 

59     W< IXP)=X( I )-*( IXP)  B0TM187O 

CD=1.  BBTM188C 

GB  T0  58  60TMt89O 

96  G0  T0  (ll2.a7).IND  B0TMI900 
112  IF  (FP-F)  37.91.91  BflTM19IO 

91  C=2.«(FP+F-2.»FH0LD)/<FP-F )«»2  BBTM1920 

IF  (D«(FP-FH0LD-SUM)««2-St»')  87.37,37  BBTM1930 

67  J=JIL»S*1  BflTMI940 

IF  (j-jj)  eo.eo.ei  botmi9SO 

£0  Da  62  I=J.JJ  BaTM1960 

K=l-N  8eTM1970 

62     M(K)=»(I)  BaTM1980 

D0  97  I=JIL.N  BBTM1990 

97     l.(I-l)=W(I)  BBTM2000 

ei   IOIRN= IDIRN-N  BBTMZOIO 

IT0NE=:3  BaTM2020 

K=ICIRN  BBTM2030 

IXP=JJ  BBTM204C 

AAA=0.  BflTM2050 

00  67  1=1. N  BBTM2C60 

IXP=IXP*1  BflTM2070 

».(K)=W(IXP)  BBTM2080 

IF  (  AAA-AE>SF(I»(K)/E(  I  )  )  )  66.67.67  BBTM2090 

te  AAA=ABSF(*(K)/e( I ) )  BeTM2100 

67  K=K+1  BBTM2110 

0UMAG=1.  BBTM2120 

W(N)=ESCALE/AAA  BBTM2130 

ILINE=N  8eTM214C 

G0  T0  7  B0TM215O 

37  IXP=JJ  8BTM216C 

AAA=0.  BBTM2170 

F=FF0LC  BeTM2180 

D0  99  1=1. N  BBTM2I90 
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IXP=IXP+l  BBTM2200 

X( I )=X( I )-•( IXP)  BBTM2210 

IF(  AAA«A8SF(E(  I)  )-A8SF(l»l  IXP)  )  )  96.99.99  B0TM222O 

98     AAA  =  ABSF(  V»(  IXP)/e(  I  )  )  BBTM2230 

59  CBNTINue  B0TM224O 

G0  T0  72  B0TM225O 

36  AAA=AAA«( l.*Ot )  B0TM226O 

G0  T0  (72,106).IND  B0TM227O 

72  IF( IPRINT-2)53,50.50  B0TM228O 

53  G0  T0  (109,ee>.IND  B0TM229O 

ICg  IF( AAA-0. 1 )eg.e9.76  B0TM23OO 

69  G0  T0  (20. 116) ,IC0N  B0TM231O 

116  IND=2  B0TM232O 

G0  T0  (  100.  101  ).  INN  B0TM233O 

IOC   INN=2  B0TM234O 

K=JJJ  BBTM2350 

00   102  1  =  1. N  e0TM236O 

K=K+l  BBTM2370 

M(K)=X(I)  B0TM23eC 

102   X<  n  =  X(  I  )  +  10.»E(  »  )  BOTM2390 

FKeEP=F  B0TM2400 

CALL  CALCFX<N,X.F)  B0TM24IO 

NFCC=NFCC*J  B0TM242O 

DDMAG=0.  BBTM2430 

G0  T0   ice  BOTM2440 

76     lF(F-FP)35,7e. 78  B0TM245O 

78     WRITE  0UTPLT  TAPE  6,60  BBTM2460 

80  F0RMAT(5X31HACCURACY  LIMITED  BY  ERR0RS  IN  F)  80TM247O 
G0  T0  20  BBTM24eO 

ee  IN0=1  B0TM249O 

35  DOMAG=0.4«SQRTF(FP-F)  B0TM25OO 

ISGRAD=1  BBTM2510 

IC8  ITERC=ITERC*1  B0TM252O 

IF(  ITERC-MAXIT  )5,5.ei  BBTM2530 

81  WRITE  0UTPtT  TAPE  6.e2.MAXIT  B0TM254C 

82  F0RMAT(  15. 291-1  ITERATI0NS  CBMPLETEC  BY  PBT)')  B0TM255O 
IF(F-FKEEP  )20.20. 1  10  BOTM2S60 

110  F=FKEEP  BaTM2570 

00  111   1=1. N  80TM25aC 

JJJ=JJJM  B0TM259O 

111    X(I)=*(JJJ)  B0TM26OO 

G0  T0  20  BflTM26lO 

ICl  JIL=1  B0TM262O 

FP=FKEEP  B0TM263O 

IF(F-FKEEP)105.7e. 104  B0TM264O 

1C4  JIL=2  BBTM2650 

FP=F  B0TM266O 

F=FK6EP  B0TM267O 

1C5  IXP=JJ  80TM26eO 

00  113  1=1. N  B0TM269C 

IXP=IXPtl  B0TM27OO 

K=IXPtN  B0TM271O 

G0  T0  (  1  14.115).JIL  BflTM2720 

114   *.(  IXP)  =  ».(K)  BBTM2730 

G0  T0  113  B0TM274C 
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1  l£    *.(  IXP)=X(  I  ) 

X(  I  )=:*(K) 
1  1  3   CBNT INLE 

JIL  =  2 

G0  T0  92 
lOfc    IF(AAA-O.l)  20,20.107 
20     EF=F 

RETLRN 
107    INN=1 

G0  T0  35 
END 


BBTM2750 
BaTM2760 
BaTM2770 
BaTM27e0 
B0TH279O 
B»TM2eOO 
e0TM28 to 

BaTM2a20 

BaTM2e30 
BBTM2e4C 

BaTM2e50 
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Identification:      MINI  -  Minimization  Routine 

FORTRAN  II  Coded  Subroutine  -  709^ 
Purpose:   To  determine  the  local  minima  of  dlf ferentlable 

functions  of  several  variables. 
Method:    See  R.  Fletcher  and  M.  J.  D.  Powell,  "A  rapidly 
convergent  descent  method  for  minimization," 
The  Computer  Journal,  Vol.  6,  No.  2,  July  I963; 
and  ¥.  C  Davldon,  Variable  Metric  Method  for 
Minimization,  ANL-599O  (Rev.),  November  1959 . 
Usage:     Entry  Is  made  by 

CALL  MINI (N , X , FX , FNCTN , GRAB , IPRINT , ERR0R ) 
where 

N     =  number  of  Independent  variables 
X     =  the  vector  of  independent  variables.   It 
should  contain  their  initial  values  before 
entry  to  MINI;  it  will  contain  their  values 
at  the  minimum  upon  return  from  MINI. 
Dimension  of  X  _^  N. 
FX    =  a  floating  point  variable  which  upon  exit 
from  MINI  will  contain  the  value  of  the 
function 

f(x,,...,xj 
at  the  minimum.   It  need  not  be  defined 
before  entry  to  MINI. 
FNCTN  =  the  name  of  a  FORTRAN  subroutine, 
SUBR0UTINE   FNCTN (X,FX) 
which  computes  the  value  of  the  function 
at  X  and  stores  it  in  FX.   X  must  be 
dimensioned  in  the  subroutine  FNCTN  as 
it  is  in  the  routine  MINI. 
GRAD  =  the  name  of  a  FORTRAN  subroutine, 
SUBROUTINE  GRAD(X,GX) 
which  computes  the  partial  derivatives  of 
the  given  function  at  X;  that  is, 

GX(I)  =  f^_(x^,...,x^),   1  =  l,...,n. 
Both  X  and  GX  ftave  to  be  dimensioned  in 

-  298  - 


the  subroutine  GRAD  as  they  are  in  the 
subroutine  MINI. 
IPRINT  =  1  after  every  Iteration,  the  values 
of  X(I),  I  =  1,N  and  FX  will  be 
printed  out. 
=  2  no  such  prlnt-outs  will  be  made. 
ERR0R  =  a  floating  point  variable  which 

specifies  the  accuracy  to  which  the 
function  f(x, ,...,x  )  Is  to  be  minimized. 
Restrictions: 

This  subroutine  has  been  dimensioned  to  handle 
a  function  of  up  to  10  Independent  variables; 
that  Is  N^  10.   If  It  Is  necessary  to  decrease 
the  program's  space  requirements  or  If  It  Is 
desired  to  handle  more  Independent  variables, 
the  cards  of  the  FORTRAN  source  deck  which 
contain  dimension  specifications  should  be 
modified  accordingly. 
Requirements : 

a)  System  Library  Functions  (closed  subroutines) 
SORT 

The  routine  also  uses  the  subroutines  necessary 
to  write  an  output  tape.   These  subroutines  are 
discussed  more  fully  in  the  last  section  of  this 
report . 

b)  System  Built-in  Functions  (open  subroutines) 
MINI 

c)  Storage 

702^Q  -  12j6q   locations  plus  (3N^+  5N)  locations 
for  dimensioned  variables,  where  N  is  the 
number  of  independent  variables,  plus  the 
required  subroutines  listed  in  a) . 
Test:     This  program  cannot  handle  the  function  of  10 

variables  cited  in  the  SC(2f0P  write-up  because 
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that  function  has  an  undefined  derivative  at 
the  origin.   However,  with  the  function 

f{x^,x^,x    )    =    100{[x^-10  0(x^,X2)]^+[r(x^,X2)-l]^}+x^ 
27r0(x-,,Xp)   =   arctan  {x^/x-^)  ,      x^  >  0 

=  IT  +   arctan  (x^/x-j^)  ,   x-j^  <  0 

r  ^      ^  2  ,    2,1/2 

rix-j^jX^)   =  (x^  +  x^) 

which  has  a  steep  sided  helical  valley  in  the 
x^-dlrectlon,  the  minimum  was  reached  in  l6 
iterations  from  the  starting  point  (-1,0,0) . 
SC00P  required  around  TOO  minimization  cycles 
to  get  to  the  minimum  from  the  same  starting 
point . 

Author:    Eva  V.  Swenson 

Date:      July  1964 
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MINI  -  ^'I^IMIZATI(^^  sbliine  -  FeBTH*N  ii  ceoEC 
r  ;m   L0CAL  MINIML^'  0F  a  FUNCTieK  er  k  variadles.  n^u  »'ath  utility.    miniooic 

C       ....This  DECK  IS  serialized  Ft^ev  K  I M  C  0 1  0  TB  yiNI1650 MINI0020 

SOfiWauTINc  MINI  (N.X.FX.FUK  .DEP  .  IPC  IKT  .eFFVIN  )  MINI0030 

C  MINI004C 

C           X    IS  THE  VECT0R  BF   N    INCEPENCENT  VAKIAELES  MINI0050 

C           FX    IS  THE  VALLE  0F  THE  GIVEN  FLNCTI0N  AT    X  MINI0C60 

C           FLN   C0WPLTES   FX   GIVEN    X  MINI0070 

C           DER   CeMPLTES  THE  GRADIENT   GX   BF  THE  GIVEN  FLNCTiaN  MINIOOeO 

C           IPHINT  =  1   IF    X   AND   FX    ARE  TB  EE  PBINTEC  AT  EVERY  I TE R AT  I BNM I N I C090 

C                    =  2    IF  N0  SLCH  INFeRMATI0N  IS  DESIRED  MINIOIOO 

C  0FFMIN    IS  THE  DESIRED  ASSBLLTE  DISTANCE  BF    X   FR0M  TKE  M  I M K . M I N 1 0 1  1 0 

C  MINI0120 

DIweNSIZN  X(lC).GX(10).Y(lO).CYtlC),S(10).Tl(10).SIG(lO)  MINI0I30 

DIMENSION  A(  IC.  10)  .0(  10, IC  )  .H(  10 .  10)  MINI014C 

EQLIVALENCt  (GY.Tl)  MINI0150 

F       FUN.CER  MINlOieO 

C  MINI0170 

C           C0MPUTC   FX.    GX   AND  SET   H  =  LNIT  MATRIX  INITIALLY,  THUS  ThE  MINIOISO 

C  FIUST  STEP   SCI)    T0WARD  THE  KINIWUK  IS  TAKEN  DB«N  THE  LINE   MINI0190 

C              «F  STEEPEST  DESCENT.    ITbRATIBN   K0UNT    IS  SET  T0  ZEfiB.  MINI0200 

C  MINI0210 

G0  T0  0«,35  ).IPRINT  MINIC220 

Jit           virWITE  0LTPLT  TAPE  6,10,N  MINI0230 

35     CkJ  le  1  =  1  .N  MINI0240 

D(o  25  J=I.N  MINI0250 

25     l-(  I  .  J  )  =0.0  MINI0260 

10     K  I.  I  )  =  l  .C  MINI0270 

Ki!UNT  =  C  MINI028C 

CALL  FLN(X.FX)  MINI029C 

CALL  CEH(X,GX)  MINIC300 

n     GH  T0  ( 32.23  ),  IPRINT  MINI0310 

32     WKITE  ULTPLT  TAPE  6 . 3 3 . K 0LN T , F X , ( X ( I ) , I = 1 , N )  MINI0320 

C  MINI0330 

C           ESTAbLISH  A  OIWECTIBN    S(I)    AL0NC  HHICH  TB  SEARCH  FBR  A  MINI03AC 

C  RELATIVE  MINIMLK  AND  E0X  0FF  AN  INTERVAL    X(I).  X (  I  )  ♦£ T A • S (  I  ) M I N I  0 350 

C              IN  THIS  OIRECTIBN  WITHININ  »HCH  A  RELATIVE  ^'IMMU^'  EXISTS.   MINI0360 

C  MINI0370 

23           D0  3  1=1, N  MINI03eC 

S(  I  )=0.0  MINI0390 

CH   3   J  =  1  .N  MINI  0400 

3       S( 1 )=S( I )- (H( I , J)«GX( J) )  MINIOAIO 

INCEX=1  MINI0A20 

GH  T0  26  MIM0430 

29     CSX=0.  MINI044C 

Dl4  4   I  =  1  ,N  MINI0450 

t              GbX=GSX*(CX( I )«5( I > )  MINIOoeO 

eL=-GSX  MINI0A70 

ETA  =  MIMF(1.,-2.«(FX/GSX))  MINI0480 

Di)  5  I  =  1  ,N  MIN  lOOQO 

b      Y(  I  )=X(  1  )»(tTA»S(  I  )  )  MIM10500 

CALL  FLN(Y,FY)  MINI0510 

CALL  CEH(Y,GY)  MINI0520 

GbY=C.0  MINI0530 

D0  £   1 =1 .N  MINI0540 

6      CbY=GSY4 (CY( I )»S( I ) )  MINI0S50 
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R0LTINE  -  FeBTR*N  II  CBOEC 


AND 
et'ENT  2, 


IF  THE  FUNCTier>4   FY   HAS  DECREASED  AND  IS  STILL  DECREASING  AT 

Y(l).   THEN  THE  INTERVAL  TAKe^   IS  T  (!  0  SKALL.    MeCIF " 

REPEAT  FP0M  STATEMENT  23.    ZTHERViISE  PROCEED  T0  ST 

IF(CSY  )   1.2.2 

IF(FY-FX  )   ig.2.2 

IF(GTA-l  .  )  20.21.21 

OH  22   1=  1  .N 

OH  22  J=  1  .N 

H(I.J)=H(I.J)+((S(I)»S(J))/EL) 


X(  U  =Y(  I  ) 
CALL  FLN(X.FX) 
CALL  DER ( X  .GX ) 
GH  T«1  23 

ESTIMATE  THE  L0CATI0N  ZF  THE  RELATIVE  flMVUI 
mITHIN  THE  INTERVAL  CETEPNINED  AEZVE. 

Z=((3./ETA)«(FX-FY))+GSX+CSY 

W=SGRTF( (Z»»2)-(GSX«GSY)) 

F,JAC=(GSY  +  i«-Z)/(GSY-GSX+(2.«*») 

ALPHA=ETA«( l.C-FRAC) 

C0  7  I = 1 .N 

S1G(  I  )=ALPHA»S(  I  ) 

INDEX=2 


X(  I  )»ALFHA«S(  I  ) 


CH  fcl   I  =  1  .N 

Y(  I  )=X  (  I  )*bIG(  I  ) 


EVALUATE   FZ   AND  ITS  GRADIENT   GY   AT  THE  INTERFeLATEC  PelNT. 


CALL  FL.-J(Y.FZ) 
CALL  D€R(Y.GY) 


[S  GREATER  THAI 


FY.  C2NSICER  THE  SfALLER 


.      TEWvAL     riANGING    FRfJN-        X  (  I  )  +  A  L  PH  A  « S  (  I  >         T0     EITHER        X(I)         I8R 
X(  I  )  tETA»S(  I  )         fcHEREvER        F        ASSUMES     A     S^'ALLFR     VALUE.     AND 
REPEAT      INTEHP0LAT I0N    FR0y     STATEMENT     2.         eTHEBWlSE     PReCEEC     T0 


TEMCI 


36. 


IF(M  IN1F(FX,FY )-FZ )     37,39,36 

GS/r  =  C.O 

C0     ^1      1  =  1  ,N 

GbZ  =  GSZ  +  <  S(  I  )»GY) 

IF(FX-FY  )     35  ,'»0.40 

ET A=(  1  .-FRAC )»ETA 

FY  =  FZ 

GSY=GSZ 

G0     T0     2 

ETA  =  F;)AC»ETA 

FX=FZ 

GSX=GSZ 

00     36     1  =  I  .N 


M1NI0560 
MIN10570 
MINI0580 
MINIOS90 
MINI060C 
MINI0610 
MINI0620 
MINIOeJO 
MIN1064C 
MINIOeSO 

MiNioeeo 

MINI0e70 
MINIC680 

MiNioeQo 

MINI0700 
MINI0710 
MINI0720 
MINI0730 
MINI074C 
MINI0750 
MINI0760 
MINI0770 
MINI0780 
MINI07gO 

MiNiceoc 
MiNioeio 
MiNioazo 

MIN10e30 

MiNioe^c 
MiNioaso 
MiNioeeo 

MINI0e70 

MiNioeec 

MINI0890 

MiNioqoo 

MINI0910 

MiNiog20 

MINI0930 
MINI  0940 
MINI0950 
M1NIC96C 
MINI0970 
MINI0980 
MINI0990 
MINI ICOO 
MINI IC 10 
MINI  IC20 
MINI  1030 
MINI 104C 
MINI  IC50 
MINI 1C60 
MINI  1070 
MINI  1080 
MINI 1C90 
MINI  1  100 
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.IMIZATIBN  R0LTINe  -  FZPINf 


X(    I  )=Y(   I   ) 

Y(   I  )=GY(   I   )-GX(   I   ) 

i 

GX(  I  )=GY (  I  ) 

FX  =  FZ 

K£!UNT  =  KUUNT+  1 

c 

c 

fHOIFY      THE      MATRIX 

c 

ARUbT      THh-     FLNCTIH 

c 

FfjUM     STATEMENT     31 

KN  ThF  BASIS  BF   INFeRNATIBN  0D' 
kLKNG  THE  CIRECTieN   S<I)    AND  ( 


A  IKEC 
lEPEAT 


SIGY=C. 

YHDEN=C. 

00  13  1=1 .N 

Tl  (  I  )  =  0.0 

OH  12  J=  1  ,N 

T 1(  I  )  =  ( Y ( J  )»F( J,  I  )  )  +  T  1  (  I  ) 

S1GY=SIGY+(SIG( I )• Y( I ) ) 

YHCEN=(T1(  I)»Y(I))tY(-DEN 

OH  11      1= I .N 

OH   14   J=1.K 

B(I.J)=-(Y(I)»Y(J)  )/YHDEN 

OH   1£   1=  1  .N 

00  lb  J=  1  .N 

A( I . J )=C. 

00  15  K=  1  .N 

A(1.J)=A(I,J)*(H(I,K)»0(K.J)) 

D0   le   1=  1  .N 

00   16   J=  I  .N 

B( 1 . J )=0. 

00   16  K=  1  .N 

tl(  I,J)=B1  I,J)  +  (A(I,K)»H(K,J)) 

00   17   I  =  1  .N 

C0   17  J=  1  ,\ 

H(  I.J)=H(  I.JlfDC  I.J)  +  (  (SIGCI  )"SIG(J))/SIGY) 


IF  AHS0HjTfc  OlbTANCE  FRZf/  MMKLW   IS  LESS  THAN    aFF> 
TERMINATE  PR0CEDORE. 


TEWP=0.0 

00  11   I = 1 .N 

G0  T0  {DP .13)  .   INDEX 

TtN'P=(  S(  t  )»S(  I  )  l+TEMP 

G0  T0   11 

Ttwp  =  (SIG(  I)«SIG(  I  ll+TCMP 

CMNT  INUe 

IF( SORTF( TEMP l-aFFCIN )     27,27,?e 

G0     T0     ( 29. 30 ). INDEX 

RtTLiRN 

F0WMAT(/6H  CYCLE6X1HF11X9HX(I  ).I^I.I2) 

F0WMAT(/I<J,lPaFie.7/(2OX7eit.7)) 
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Identification:      MSR  -  Minimal  Surface  on  a  Rectangular 

Mesh 

7090  -  FORTRAN  II  Coded 
Purpose:   To  compute  the  minimal  surface  for  given  boundary 

values  on  a  rectangular  mesh. 
Method:    See  NYO-9497,  "Iteration  Methods  for  Nonlinear 

Problems,"  by  S.  Schechter. 
Usage:     Enter  by 

CALL  MSR(KL,NM,L,W,EPS,EPS1,K) 

and  provide 

C0MM0N   M,MS,H,YK,UA,U 
DIMENSI0N   U(1500),  UA(1700) 

where 

M     =  number  of  columns  In  the  mesh 

MS    =  number  of  rows  In  the  mesh 

M^MS  ^  1700 

H     =  Ax   (=  column  mesh  width) 

YK    =  Ay   (=  row  mesh  width) 

¥     =  Newton-Raphson  formula  coefficient  -- 
discussed  In  NYO-9497,  page  12. 

UA    =  block  of  values  on  mesh  (boundary  values 
and  Initial  guesses  for  interior  points)  -- 
numbered  by  rows  from  left  to  right,  start- 
ing with  bottom  row.   Reasonable  Initial 
guesses  can  be  computed  as  the  average  of 
the  values  computed  for  an  Interior  point 
using  linear  approximations  based  on  the 
row  and  column  boundary  values. 

U     =  block  of  values  on  Interior  of  mesh. 
Initial  values  of  U  must  coincide  with 
Initial  guesses  on  Interior  points  of  UA . 
Final  results  are  In  U  block  upon  return 
to  main  routine.   Numbering  Is  by  rows  and 
from  left  to  right,  starting  with  bottom  row 
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KL         =   maximum  number  of  Iterations  allowed 

EPSl  =  allowable  error  for  absolute  convergence 

test.   |U.  .  .-U.  .1  <  EPSl  --  where  U.  . 

is  the  value  of  U(J)  after  the  i-th 

iteration  —  must  hold  at  every  U(J)  for 

which  |U^  J  <  EPSl. 

EPS   =  allowable  error  for  relative  convergence 

test.   I  (Uj_^;j_  .-U^  i)/U-j_  J  <  EPS  must  hold 

at  every  U(j)  for  which  |U.  .|  >  EPSl. 

Set  NM     =  (M-2)*(MS-2) 

L      =0 

Notes:    MSR  is  a  package  of  3  subroutines:   MSR,MSR1,  and 

MSR2,  where  MSRl  evaluates  quantities  R(J),  A(J) 

in  terms  of  quantities  computed  in  MSR2. 

Recommended  values  for  EPS  are  EPS  =  H  *  YK  or 

EPS  =  H*YK  =  10"^,  with  a  lower  limit  of 

EPS  =  10"5.   EPSl  should  be  of  the  order  of  10"''' 

or  smaller.   The  running  time  is  of  the  order  of 

(^  +  — ^^—r   *  NM  *  K)  minutes  where  K  is  the 

^   2*10^ 
iteration  count. 

The  final  iteration  count  K  is  returned  to  the 

main  routine. 

The  program  is  compiled  with 

DIMENSI0N  U(1500),  UA(1700) 

If  the  dimensions  are  to  be  changed  then  the 

dimensions  of  the  arrays  R,A,V  in  MSR,  MSRl  and 

MSR2  should  agree  with  that  of  U,  while  the 

dimensions  of  PP,  PQ,  FPP,  FPQ  and  FQQ  should 

agree  with  that  of  UA . 

Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
SQRT 

b)  System  Built-in  Functions  (open  subroutines) 
ABS,  XM0D 
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c)  storage 

The  coding  of  the  program  requires  ^88-,„  =  750q 
locations  plus  the  required  subroutines  listed 
in  a) .   In  addition   (5*J+3*I)  locations  (where 
I  is  the  dimension  of  the  array  U  and  J  is  the 
dimension  of  the  array  UA)  are  required  for 
temporary  storage.   The  routines  also  require 
ll-j^Q  +  I  +  J  locations  of  C0MM0N.   The 
subroutines  use  the  7  locations  of  C^MM^N  below 
the  array  U  to  transmit  information  among 
themselves . 
Author:    Norman  Rushfield 


Date:      January  1964 
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INIMAL  SURFACE  eN  A  RECTANGULAR  KESH  -  FORTRAN  II  C0DeO 


MINIMAL  StRFACE   WITH  GIVEN  EeUNCAHY  VALLES  SUER  I  KF  3   MSROOOIO 

Suef?aLTINE  MSR  (KL  .NW  .L  .V..EPS  .EPSl  .K)  MSR0C020 

C1MENSI0N  H(  15C0)  .A(  1500)  .L(  1500)  ,Wt  IbOO)  ,UA(  1700)  MSR00030 

C0^^'0N  M.MS  .»-,  YK  ,LA,L  .  IL.HYK  ,  I  J,  UP  .ILP.H?  ,YK2  MSR00040 

IF(L)7,7.1  MSR00050 

L=l  MSR00060 

H2=h»«2  MSH00070 

HYK=h»YK  MSR00080 

YK2=YK«»2  MSR00090 

IJ=1  MSHOOIOO 

IL=M+2  MSROOllO 

IJP=1  MSH0OI2O 

ILP=M+2  MSR00130 

K=C  MSROOIAC 

00  2  J=1.NM  MSR00150 

V(J)=U(J)  MSR00160 

CALL  MSRl(H.A)  MSR00170 

U( J )=U( J)-»«(R ( J )/A( J) )  MSR00180 

CUNTINLE  MSR00190 

K=K41  MSR00200 

IF(K-KL )fi.9.q  Msnoozio 

DH  12  1=1, NM  MSH00220 

IF(ABSF(V(I))-cPSl)l0.l0.4  MSR00230 

IF(ABSF(L(I))-EP 51)12.12.1  MS RO 0240 

IF(ABSF((V(I)-L(I))/'V(I))-EPS)12.12.1  MS  000250 

C0NTINLE  MSH00260 

RtTLRN  MSR00270 

gNC  MSR002eO 
MINIMAL  SLRFACE  *  I TH  GIVEN  eBLNOABY  VALLFS             SUER  2  BF  3   MSW00290 

bUtB^OTINE  MSRKR.A)  MSR00300 
DIMENSION  R(15  00),A(1500).L<1=00>.LA(1700),FP(1700).FQ(17  00).FPP(1MSH00310 

170  0).FPG(1700),FGQ(1700)  MSR00320 

CkJNMtJN  M.MS.F.  YK.LA.L.  IL.HYK.  IJ,  IJF.ILP.F'2.YK2  MSH00330 

IF( XM0CF( IL.y ) )1 ,2.1  MSR0034C 

IL=ILt2  MSR00350 

bA(  ILP  )=L(  UP)  MSR00360 

ILP=IL  MSR00370 

UP=IJ  MSR003e0 

ILM=IL-M  MSW00390 

CALL  MSR2  (FP.FQ.FPP.FPO.FCG )  MSR00400 

R(IJ)=(FP(IL-l)-FP(IL))/Ht(FC(IL^)-FO(IL))/YK  MSROOAIO 
A(  IJ)=2.»FPQ(  IL)/HYK+(FPP(  IL)tFPP(  IL-1  )  )/H2+(FC0(  IL)+FQC(  lUM)  )/YK2MSH00420 

IF( IL-M»(MS-1 )♦! )3,5.3  MSR00430 

IL=M+2  MSR00440 

IJ=1  MSH00450 

G0  T0  14  MSR00460 

lL=ILtl  MSR00470 

IJ=IJ*1  MSR004e0 

HtTURN  MSR00490 

END  MSR00500 
'   MINIMAL  SLRFACE  » I TH  GIVEN  EKLNDARY  VALUES             SUER  3  0F  3   MSH00510 

SueRHLTINE  MSH2  (FP,FQ.FPF.FPC.FCC )  MSnOC520 
DIMENSION  LA(1700).FP(170C),FC(17CO).FFP(1700).FPC(17  00).hCQ(1700)MSR00530 

1 .U( 1500 )  MSR0C54C 
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ll^'AL  SURFACE  eN  A  RECTANGULAR  MESH  -  F0RTRAN  II  C0OED 


C0Mi«0N  M  ,MS  .  t- .  YK  ,U  A  ,U  .  IL  .HYK  MSR00550 

IK=IL  MSR00560 

IKM=IK+M  MSR00570 

P=(UA(  IK  +  l  )-UA (  IK)  )/H  MSROOSeO 

Q=(UA(  IKM )-UA(  IK )  )/YK  MSR00590 

G  =  SQRTF(  l.tP««2  +  Q»»2)  MSR00600 

FPG(IK)=  HYK» (-P*Q )/(G«»3 )  MSR00610 

FP(IK)=  HYK»P/G  MSR00620 

FPP(IK)=  HYK«(  l.+Q»«2)/(G««3>  MSR00630 

FQ(IK)=  HYK»Q/G  MSR00640 

FQO{IK)=  HYK»( l.+P»»2)/(G«»3)  MSR00650 

IK=IL-1  MSR00660 

IKM=IKtM  MSR00670 

P=(UA( IKt 1 )-UA( IK ) )/H  MSR00680 

Q=(LA(  IKN' )-UA(  IK  )  )/YK  MSR00690 

G  =  SaRTF(  l.+P«»2<-Q««2)  MSR00700 

FP(IK)=  hYK»P/G  MSR00710 

FPP{IK)=  HYK« ( l.+Q»»2)/(G»»3)  MSR00720 

IF( IL-2»M)2,3,q  MSR00730 

IK=IL-M  MSR00740 

IKM=IL  MSR00750 

P=(UA(  IK  +  1  )-UA(  IK)  )/H  MSR00760 

Q=(UA( IKM)-UA( IK ) ) /YK  MSR00770 

G  =  SGRTFt  l.-fP»»2tQ«»2)  MSR007eO 

FQ{IK)=  hYK»Q/G  MSR00790 

FQG(IK)=  HYK»(  l.*P»»2)/(G«»3)  MSR00800 

RETURN  MSR00810 

END  MSRO0e20 
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Interpolation  and  Approximation 

1.  LINT    Lagrange  Polynomial  Interpolation  - 

FORTRAN  Coded 

2,  LEAST   Non-Linear  Least  Squares  Package  - 

FORTRAN  Coded 
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Identification:      LINT  -  Lagrange  Polynomial  Interpolation 

FORTRAN  II  Coded  -  70 90 

Purpose:   Given  the  values  of  an  undetermined  function  F(x) 
at  a  finite  number  of  equally  spaced  points 
(x,  ,  k  =  1,...,N),  this  subroutine  will  give  an 
approximation  for  F(x)  where  x^  <  x  <  x„.   Also, 
there  Is  an  option  for  an  approximation  of  F'(x) 
and  F" (x) . 

Method:    From  the  several  standard  equations  relating  to 

Lagrange  Interpolation,  new  equations  were  derived, 
applicable  for  efficient  machine  use,  which 
calculate  F(x) ,  F'(x)  and  F"(x).   These  equations 
are  In  the  appendix  to  this  wrlteup. 

Usage:     Note:   It  Is  assumed  that  the  x,  (k  =  1,N)  are 
N  equally  spaced  points,  such  that  If 
j  <  k,  then  x.  <  x^. 

CALL  LINT(N,X,DH,AO,IFLAG,PCT,CD) 

where 

N     =  the  number  of  points  x,  ,  for  which  F(x,  ) 

Is  known . 
X     =  the  unknown  point  x,  for  which  we  want 

to  approximate  Ffx),  F'(x),  F"(x). 
DH    =  the  Increment  between  succeeding  x.. 
AO    =  If  N  Is  even:   AO  =  ^m/o 

If  N  Is  £dd:    AO  =  ^ri^+i)/2 
From  a  geometric  point  of  view: 
If  N  Is  odd  AO  Is  the  value  of  the  midpoint 

of  the  interval  [x^,x^]; 
If  N  Is  even  AO  Is  the  value  of  the  point  x. 
which  Is  to  the  Immediate  left 
of  the  midpoint  of  the  Interval 
[x^,xj^]. 
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IFLAG     =  0  if  just  P(x)  is  desired 

=  1  if  F(5c)  and  F'(x)  are  desired 
=  2  if  F(3c),  F'(x),  and  F"(5c)  are  desired 
FCT   =  A  one-dimensional  array  for  the  N  values 
of  the  undetermined  function  F(x)  that  are 
known. 

Note:  (1)  FCT(j)  =  F(x.),  j  =  1,...,N 
'  (2)  there  MUST  be  a  DIMENSI(;2(N  state- 

ment for  FCT  in  the  main  program. 
CD    =  A  one-dimensional  array  of  size  3,  such 

that  after  LINT  has  been  called,  the  follow- 
ing will  result: 
CD(1)  =  F(x) 
CD(2)  =  F'(x) 
CD(.3)  =  F"(x) 
Note:   CD  must  be  included  in  a  DIMENSI^^N 
statement . 
Output:   Besides  being  stored  in  CD,  the  results  are  also 

printed . 
Time:      N/25  hundreths  of  an  hour. 

Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
The  routine  uses  the  subroutines  necessary  to 
write  an  output  tape.   The  routines  are  discussed 
more  fully  in  the  last  section  of  this  report. 

b)  Storage 

2884,Q  =  5504o  locations  plus  the  required 
subroutines  listed  in  a) . 
Author:    Norman  Pollock 

Date:     August  I963 
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Appendix: 


Note:   Equations  2-7  are  valid  only  If  n  Is  even. 
Equations  8-I5  are  valid  only  If  n  Is  odd. 


1.      p 
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number   of  points 


2.      A 


n      (P-  +  -2   n  -  t) 
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^-^1  ^         (|   +  k)(p-k-l) 


4.      A      ,      ^^      =      A 

_n; 
2 


Zi-^l     -      -^(^   ^   4^    (^,n  _  .) 


5.      A 


k+1 


(^  +  k)     ^  (p-k-i)2  "-^k+lFk^ 


6.      A 


-1 


(n-2)      -      ^-(n-2) 

2  2 


j=2    (p+^   -j)2 


]    +  A.^    oJ 


^^    1^  (P+I-Jl 


7.      A 


(k   -  i   n)    ^         -2A^        ^  ..^ 


2A, 


A,     + 


^^+1  (f   +  k)    ^     (p-k-l)2    '     (p-k-l)5  ^       TFT?^ 


8.      A 


n-1       (p    +l(n-l)-t) 


-^(n-1)  t=l 


TH^^ 


(k-^)(p-k) 
^'      Vl     =      t    (il±l  +  k)(p-k-l)    ^    '^ 


,  n^  . 

10 .      A    .  =      A     ^  [   2Z  ^ 

-^(n-1)  -^(n-1)       t=l    (p  +  ^(n-l)-t: 
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11-    \    =    (ii±i  +  k)  '  (p-k-i)2  ""  *i^  ^TFk^  • 

II  n-1  _, 

12.      A    ,      .^      =      A  [   XZ     T-^ o 

^%^  4  (n-1)        fcl      (p+i(n-l)-t)2 

+  A 
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Identification:      LEAST  -  Non-Linear  Least  Squares 

Package  -  3  FORTRAN  Il-Coded  Subr, 

Purpose:   To  "fit"  (in  the  sense  of  least  squares)  a  given 
function  to  a  given  data  set.   The  function  to  be 
fitted  can  be  any  "well-behaved"  mathematical 
function  for  which  the  derivatives  exist  and  for 
which  the  data  set  does  not  give  rise  to  points 
of  singularity.   By  supplying  the  correct  function 
and  Its  respective  derivatives  (in  the  form  of  a 
subroutine),  the  user  will  be  given  the  function 
parameters  which  best  fit  the  data.   As  written 
the  program  capacities  are: 

5  or  fewer  Independent  variables; 
500  or  fewer  data  points; 
20  or  fewer  parameters. 

Method:    See  Los  Alamos  Report  LA-2367,  The  Solution  of 
the  General  Least  Squares  Problem  with  Special 
Reference  to  High  Speed  Computers,  R.  H.  Moore 
and  R.  K.  Zelgler,  3-4-60. 

Note:     Most  of  the  Information  In  this  wrlteup  Is  taken 
directly  from  the  Los  Alamos  report  noted  above 
and  Its  addenda. 

Usage:    The  three  subroutines  In  this  package  are 
LQINP,  LEAST,  LQ0UT . 
I.    CALL  STATEMENTS 

1.  LQINP  Is  entered  with  the  statement 

CALL  LQINP (N, IK, IM,M, TEST, NDUM, IPR , IFG ) 
The  subroutine  reads  the  data  from  tape  5  and 
returns . 

2.  LEAST  Is  entered  with  the  statement 

CALL  LEAST(N,IK,IM,M,TEST,WAR,SSQ,IDP, 
DET,NDUM,IPR,IFG) 
The  subroutine  performs  the  Iterations  and  test 
for  convergence  when  a  set  of  data  Is  being 
fitted  by  the  method  of  iterative  least  squares- 
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3-  LQ0UT  is  entered  with  the  statement 

CALL  LQ0UT(N,IK,IM,M,WVAR,SSQ,IDP) 
The  subroutine  writes  out  results  on  tape  6 
and  returns. 
II.    DATA  DESCRIPTION 

LQINP  is  prepared  to  handle  either  of  two  types 
of  data  arrangements: 

a)  point-wise  loaded  variables  in  which  all  the 
data  for  the  first  point  is  loaded,  all  that 
for  the  second  loaded  next,  ...,  and  finally, 
all  that  for  the  N-th  point. 

b)  block-loaded  variables  in  which  the  whole  set 
of  Y's  is  loaded,  followed  by  all  the  X(l)'s, 
followed  by  all  the  X(2)'s,...,  followed  by 
all  the  X(M) 's  and  followed  by  all  the  weights, 
if  any. 

Both  data  arrangements  require  some  basic  control 
information,  the  format  of  which  is  the  same  for 
both  forms. 
III.    ARGUMENT  DEFINITIONS 

a)  values  read  from  the  second  data  card  in  the 
input  deck: 

N     is  the  number  of  data  points  to  be  loaded 
IK    is  the  number  of  parameters  to  be  loaded 
IW    =  0,  all  W(I)'s  are  set  =  1.0 

=  1,  weights  are  read  from  the  cards 

=  2,3,  see  page  4,  LA  2367,  addenda. 
M     is  the  number  of  independent  variables. 

M  must  be  _<  3. 
IB    =  0,  data  is  loaded  block-wise 

=  1,  data  is  loaded  point-wise 
ITEST  =  0,   sets  TEST  =  10"' 

=1,   a  value  for  TEST  is  read  from  input  deck 
IDUM  =  0,  no  values  for  DUM  variables  present  in  deck 

=  1,  values  of  DUM  variable  to  be  read  from  cards 
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IPR   =  0,  the  program  Iterations  and  final 
matrices  are  not  included  in  the 
final  output 
4   0,  they  are  printed 
IFG   Control  of  algebraic  sign  of  the  parameter  set 
=  0,  does  not  allow  any  parameter  to  change 

sign  for  '^    iterations;  then  sign  changes 
are  permissible  for  remaining  iterations 
=  1,  signs  always  free  to  change 
=  2,  signs  never  free  to  change 

b)  values  read  from  third  card  in  input  deck: 
IM    is  the  number  of  parameters  to  be  held 

constant  during  the  computation.   IM  must 
be  <  IK.   If  IM  =  0,  this  third  card  may  be 
totally  blank  but  it  must  be  included  in  deck. 
IX    the  subscripts  of  the  parameters  being 
held  fixed.   There  are  IM  such  numbers. 

c)  other  values  from  input  deck: 

PG    are  the  initial  estimates  of  the  parameters. 
This  set  of  numbers  is  placed  immediately 
behind  the  third  card  in  the  deck.   There 
are  IK  such  numbers. 

TEST  denotes  a  number  such  that,  when  all  the 

parameters  after  some  number  of  iterations 
have  changed  by  less  than  TEST,  control  is 
returned  by  LEAST  to  the  calling  program. 
(See  LA-2567,  p.  ^4.) 

d)  values  computed  during  calculation  and  arguments 
in  C0MM0N  storage: 

*WVAR  denotes  the  weighted  variance 

*SSQ  denotes  the  sum  of  the  squares  of  the 

unweighted  residuals 
*IDF  den6tes  the  number  of  degrees  of  freedom 
*DET  denotes  the  value  of  the  determinant  of 

the  normal  equations 
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Each  subroutine  in  this  package  contains  the 
following  C0MM0N  and  DIMENSI0N  statements: 
C0MM0N   ALAB,BM,DUM,DY,IX,PART,PG,P,SP,¥, 

X,YC,Y,Z 
DIMENSI0N  ALAB(12),BM(20,21),DUM(100),DY(300), 
IX ( 20 ) , PART ( 20 ) , PG ( 20 ) , P ( 20 ) , SP ( 20 ) , 
W(500),X(5,500),YC(500),Y(500),Z(5) 
ALAB   denotes  a  vector  which  will  contain  the 
Information  read  from  the  first  card  In 
the  Input  deck.   This  Information  will 
be  printed  on  the  top  of  each  output 
sheet  of  the  program. 
*BM     denotes  the  Inverse  of  the  least  squares 
matrix. 
DUM    denotes  a  dummy  set  of  niimbers  carried 

throughout  the  problem.   These  may  be  used 
for  testing,  comparing  or  any  other  purpose 
desired  by  the  coder.   Space  for  DUM  must 
be  provided  even  though  they  are  not  used. 
*DY     denotes  the  residuals  (Y-YC) 

IX  denotes  the  "serial  numbers"  of  the 
parameters  that  are  being  held  fixed.   Total 
number  of  IX ' s  must  be  =  IM. 

*PART   denotes  the  values  of  the  partial  derivatives 

with  respect  to  the  P's 
PG     denotes  the  Initial  estimates  of  the 

parameters 
*P      denotes  the  final  values  of  the  parameters; 

I.e.  those  values  obtained  such  that  the 

condition  TEST  Is  satisfied. 
*SP     denotes  the  standard  deviations  of  the 

parameters 
W      denotes  the  weights  associated  with  the  Y's 

X  denotes  the  Independent  variables.   The  1-th 
point  for  the  J-th  Independent  variable 

Is  X(J,I) . 
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*YC     denotes  the  values  of  the  function 

evaluated  for  each  point  with  the  final 

values  of  the  parameters. 
Y      denotes  the  dependent  variable 
Z      is  a  variable  which  is  defined  by  LEAST 

as  Z(J)  =  X(J,I)  for  a  given  I  prior  to 

calling  the  YP  subroutine.   (See  Usage 

of  YP,  below. ) 
IV.    OUTPUT  OF  RESULTS 

Subroutine  LQ0UT  writes  out  on  tape  6  the  final 
results  as  described  in  pages  57-6O  of  LA-2567 
for  its  R-subroutine,  and  on  pages  87-94. 
V.    REQUIRED  SUBROUTINE  YP 

In  order  to  use  the  LEAST  subroutine,  an 
additional  subroutine  must  be  prepared.   This 
subroutine,  to  be  written  by  the  user,  must  be 
named  YP,  and  calculates  the  values  and  the  partial 
derivatives  of  a  function  being  fitted.   The  YP 
subroutine  is  entered  by  LEAST  once  for  each  data 
point  (that  is,  N  times)  for  each  iteration 
required  by  a  particular  problem.   The  subroutine 
must  have  the  form: 

SUBR0UTINE  YP (YT, I,N,M, IK) 

C0MM0N   [see  III  d  above] 

DIMENSI0N  [see  III  d  above] 
YT  denotes  the  value  of  the  function  at  the  I-th 
point;   N,M,IK  have  been  previously  defined. 
The  actual  coding  for  a  YP  subroutine  is  best 
described  by  an  example.   We  suppose  we  are 
interested  in  fitting  the  function 

y  =  P-,^x^  +  Pg  exp(P^X2)  , 
where  the  P's  are  parameters  to  be  estimated. 
The  partial  derivatives  of  y  with  respect  to 
the  parameters  are 

1^  =  ^1  '  If;  =  exp(P3X2),  and  |^  =  x^F ^exp {? ^x^] 
The  YP  subroutine  might  be  written  as  follows: 
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SUBR0UTINE  YP (YT, I ,N,M, IK) 

C0MM0N   ALAB,BM,DUM,DY,IX,PART,PG,P,SP,W,X,YC,Y,Z 

DIMENS I0N  ALAB ( 1 2 ) , BM ( 20 , 21 ) , DUM ( 100 ) , DY ( 500 ) , IX ( 20 ; 
X  PART (20) ,PG(20),P(20) ,SP(20) ,¥( 500 ) ,X( 5, 500 ) , YC ( 500 )  , 
X  Y(500),Z(5) 

IF  (I)  1,3,3 

1  WRITE  0UTPUT  TAPE  6,2 

2  F0RMAT(53HOSPECIAL  FUNCTI0N  Y  =  P(1)*X(1)+ 
X  P(2)*EXP(P(3)*X(2) )) 

G0  T0  h 

3  PART(2)  =  EXPF(P(3)*Z(2) ) 
YT=P(1)*Z(1)+P(2)*  PART (2) 
PART(l)  =  Z(l) 

PART(3)  =  Z(2)  *    P(2)  *    PART(2) 

4  RETURN 
END 

The  dummy  variable  DUM  can  be  used,  for  example, 
in  order  to  provide  a  means  of  using  the  YP 
subroutine  to  fit 'more  than  one  function.   One 
could  set  DUM(l)  =  FL0ATF(J),  where  J  =  1,2,3, 
etc.,  according  to  the  function  desired.   The 
first  executable  statement  in  the  YP  subroutine 
would  be  a  test  on  DUM(l),  the  alternative  being 
the  different  areas  of  the  program  in  which  the 
proper  function  is  evaluated. 
VI.    DATA  CARD  PUNCHING 

1.  First  card:   Label  Card: 


Col.  1  must  be  a  1 

Cols.  2-72  Hollerith  information:   will  be  printec 

on  the  top  of  each  output  page.   Stored 

in  ALAB  array . 
Second  card:   Point  Control  and  Parameter  Card: 
Cols.  1-3:    N:  number  of  data  points 
Cols.  4-6:    IK:   number  of  parameters 
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Cols. 

7-9: 

IW 

Cols. 

10-12: 

M: 

Cols. 

15-15: 

IB 

Cols. 

16-18: 

IT 

Cols.  19-21; 


Cols, 
Cols 


22-2^; 
25-27: 


Cols.  28-3O; 


5)  Third  card: 


0,  set  W(I)  =  1.0;  =  1,  read  W(I)'s 
number  of  independent  variables 
IB  =  0,  load  by  blocks;  =  1,  load  by  pts 

0,  set  TEST=10"  ;  =1,  read 
value  for  TEST 
IDUM  =  0,  no  DUM  variables; 
=  1,  there  are  NDUM  values  of  DUM 
NDUM:  number  of  DUM  values  to  be  read 
IPR  =  1,  printout  final  matrices; 
=  0,  do  not  print  out  final  matrices 
IFG  =  0,1,2  control  of  algebraic  sign 
of  parameter  set  (see  III  a). 
Parameters  Fixed  Card: 


Blank  card  if  £io  parameters  are  being  fixed 
Cols.  1-3:   IM    =  number  of  IX ' s  to  be  read 
Cols.  4-6:   IX(1)  =  subscript  of  parameter 

being  fixed 
Cols.  7-9:   IX(2)  =  subscript  of  parameter 

being  fixed 


Cols.       IX(IM)=  subscript  of  parameter 
being  fixed 

4)  Fourth  card:  Parameter  Initial  Estimate  Card(s): 
These  are  the  PC's.  They  are  punched  6  per  card, 
format  6EI2.7,  until  the  IK-th  estimate  is  reached 

5)  Data  Cards: 

(Both  a  and  b  punched  6  per  card,  format  6EI2.7.) 


Option  a: 


Option  b: 


is  point-wise  loading  and  will  occur  if 
cols.  13-15  (IB)  of  second  card  =  1. 
Yd),  X(1,I),  X(2,I),  ...,  X(M,I),  W(I) 
is  block-loadlngand  will  occur  if  IB  =  0 . 
Y(1),Y(2),Y(3), ■ • .,Y(N),X(1,1),X(1,2), 
X(1,3),-..,X(1,N),...,X(2,1),X(2,2),..., 
X(2,N), . ..,X(M,1),X(M,2), .. .,X(M,N),W(I) 
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VII 


W's  will  be  read  in  if  columns  7-9  (IW)  of  the 
second  card  =1.   If  weights  are  not  read  in, 
¥(I)  may  be  left  blank.   Then  all  weights  will 
be  set  =  1.0.   For  IW  =  2  or  3,  see  page  4, 
LA-2367,  addenda. 

6)  DUM  Cards: 

If  columns  19-21  of  second  card  (IDUM)  =  1, 
program  expects  to  find  NDUM  values  of  DUM, 
punched  6  per  card,  format  6F12.0. 

7)  TEST  Card: 

If  columns  16-I8  of  second  card  (ITEST)  =  1 

program  expects  to  find  a  value  for  the 

variable  TEST,  format  E12.7- 

Using  LEAST  without  LQINP  and/or  LQ^UT 

The  present  arrangement  of  this  package  makes 

it  relatively  simple  for  the  user  to  read  in 

his  data,  perform  the  "fit"  and  output  the 

results.   A  simple  main  program  of  the  form: 


Page  1 

Pa^ 

e  2 

15   IM  =  0 

D0  24   I  =  1,20 

IK  =  0 

IX(I)  =  0 

IDF  =  0 

PG(I)  =  0.0 

DET  =0.0 

SP(I)  =  0.0 

M  =  0 

D^  24   J  =  1,21 

N  =  0 

24 

BM(I,J)  =  0.0 

SSQ  =  0. 

CALL  LQINP (N, IK, 

¥VAR  =  0. 

N  =  N 

D0  20   I  = 

1, 

5000 

CALL  LEAST (N, IK, 

Yd)  =  0.0 

CALL  LQ0UT(N,IK, 

¥(I)  =  0.0 

G0  T0  15 

DY(I)  =  0.0 

END 

DUM(I)  =  0. 

.0 

D0  20   J  = 

1, 

.5 

20   X(J,I)  =  0 

.0 
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along  with  the  aforementioned  compulsory 
C0W10   and  DIMENSION  statements  would  read  in 
successive  batches  of  data  and  print  out  the 
results  until  no  more  data  existed. 
The  user  who  desires  to  compute  values  before 
entering  LEAST,  rather  than  reading  them  in, 
may  eliminate  subroutine  LQINP  without  affect- 
ing LEAST.   He  must,  however,  set  all  quantities 
required  by  LEAST  which-  would  ordinarily  be  set 
by  LQINP.   These  quantities  are: 
N     number  of  data  points 
IK    number  of  parameters 
IM    number  of  parameters  held  constant 

during  computation 
M     number  of  independent  variables  (M  _<  5) 
IDF   number  of  "degrees  of  freedom"  (See 

LA-2367,  pp.  42-44.) 
NDUM  number  of  values  of  DUM  that  have  been  set 
TEST  convergence  criterion  (suggested  value  10   ) 
IPR   =  0  if  final  matrices  and  iterations  are 
not  to  be  printed 

=  1  if  they  are  to  be  printed 
IPG   =  0,1,2  control  of  parameter  sign  (see  III  a) 
W(I)'s  weights  associated  with  the  Y's. 

If  no  special  weights,  then  the  W(I) 's 
must  be  set  to  1.0. 
IX(I) 's  if  IM  =  0,  IX's  are  0.  (There  are  IM  of  them.) 
if  IM  7/  0,  IX(1),  IX(2),  ...,  IX(IM) 
=  subscript  of  parameter  being  held  fixed. 
ALAB  a  vector  of  12  locations,  contains  Hollerith 

information  to  be  used  as  a  "label"  at  the 

top  of  any  output  from  LEAST 
DUM   if  NDUM  =  0,  DUM( 1) , . . . ,DUM( 100)  are  not 
important 

if  NDUM  r^  1,    DUM(l)  ,  .  .  .  ,DUM(NDUM)  are  to  be 
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set  equal  to  a  set  of  variables 
which  the  user  may  want  to  use 
throughout  the  problem  (see 
discussion  of  YP  subroutine  V) 
PG(I) 's  Initial  estimates  of  the  parameters 

I  =  1,2,..., IK.   There  is  a  one-to-one 
correspondence  between  the  order  of 
parameters  and  the  parameter  estimation. 
Y's    the  dependent  variables 

X's     the  independent  variables.   The  I-th  point 
for  the  J-th  Independent  variable  is  X(J,I' 
Having  set  all  the  above  variables  the  user  may 
then  CALL  LEAST(N,IK, . . . ) .   Upon  returning  from 
LEAST,  a  call  to  LQ0UT  would  output  the  results 
as  described  in  the  LA-2367  report.   However, 
if  the  user  desires  to  write  his  own  output 
routine  and/or  use  the  results  of  the  LEAST 
subroutine  for  further  calculation  he  may  find 
these  results  in  the  following  locations: 
¥V"AR   weighted  variance 
SSQ    the  unweighted  sum  of  squares  of  the 

deviations 
P(I)    final  values  of  parameters,  I  =  1,...,IK 
SP(I)   standard  deviation  of  the  parameter 

1=1,.. .,IK 
YC(I)   calculated  function  I  =  1,...,N 
DY(I)   deviation  I  =  1,...,N 
PARTtI)  partials  I  =  1,...,IK 
LET    determinant  of  the  normal  equations 
BM     inverse  of  the  least  squares  matrix 
See  discussion  of  R-subroutlnes,  pp.  57-6o, 
LA-2567.   Other  variables  previously  defined 
are  still  intact  and  may,  of  course,  be 
utilized  by  the  program. 
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VIII.   Summary  of  conditions  for  return  to  main 
program  from  LEAST  Subroutine. 

1)  Convergence  has  been  obtained  as  described  under 
convergence  criterion,  p.  44,  LA-2367. 

2)  A  total  of  25  iterations  have  taken  place  without 
satisfying  the  convergence  criterion. 

5)  The  initial  estimates  were  very  poor,  succeeding 
estimates  even  worse,  and  eventually  the 
parameters '  signs  were  being  challenged  by  the 
.program.   See  p.  42,46-47,  LA-2367. 

4)  The  value  of  the  determinant  of  the  normal 
equations  (DET)  is  negative.   This  can  happen 
when  the  parameters  stray  away  from  reasonable 
values.   This  often  indicates  that  the  function 
being  fitted  does  not  adequately  describe  the 
data . 

5)  Use  of  sense  switch  6  (see  LA-2367) . 
Sense  Switches  and  Sense  Lights: 

For  complete  information  on  the  use  of  sense 
switches  and  lights  the  user  is  advised  to  read 
the  LA-2367  report  and  especially  pp.  46-47 
which  are  a  discussion  of  the  P-routlne  that 
compares  to  our  LQ0UT  subroutine. 
Requirements: 

a)  Non-System  Subroutines 
LEAST  uses  LEQD 

which  is  a  subroutine  that  will  solve  a  system  of 
linear  equations.   The  FAP  version  of  the  routine 
LEQ  listed  in  this  report  satisfies  the  require- 
ments of  this  routine. 

b)  System  Library  Functions 

LEAST  uses  SQRT,  XIJ^Q,   and  the  subroutines  necessary 
to  write  an  output  tape.   These  subroutines  are 
discussed  more  fully  in  the  last  section  of  this 
report . 
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LQINP  uses  the  subroutines  necessary  to  read 
an  Input  tape . 

LQ^UT  uses  SQRT  and  the  subroutines  necessary 
to  write  an  output  tape. 

c )  System  Built-in  Functions 
LEAST  uses  ABS 

d)  Storage 

LEAST   l637^Q  =  31^53  locations  plus  the  required 

subroutines  listed  in  a)  and  b), 
LQINP   ^^Otq  "^   ^'^^8   locations  plus  the  required 

subroutines  listed  In  b ) . 
LQ0UT   1270-]_Q  =  2566g  locations  plus  the  required 
subroutines  listed  In  b). 
Author:    F.  Ragusa 

(Modified  version  of  Los  Alamos  code  "PAKAG") 
Date:      March  1964 
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LtAST  -  N0N-LINEAR  LEAST  SCLARES  RKUTINE  -  FBRTRAN  II  C0CEC 

CLi^AST  LUS  ALAMeS  LEAST  SQUARES  SLBB0UTINE  NYU  ^ATH  UTILITY        LEASTOOO 

C  PErtFaHMS  ThE  ITERATieNS  AND  TEST  F?R  CeNVEHGENCE  WHEN  A  SET  BF      LEASTOOl 

C  DATA  IS  BEING  FIT  BY  THE  KETHKD  0F  ITERATIVE  LEAST  SQUARES.    SEE   LEAST002 

C  LUS  ALAM0S  PUMLICATI0N   LA2367   FgR  CBKPLETe  CeSCHIPTI0N  AND        LEASTOOJ 

C  NYU  »RITE-LP  F0R  I  HauTINE  -LEAST-.                                        LEAST004 

C  LEAST0C5 

SURSauTINE  LEAST  (N,  IK.  I>',f',  TEST, V<VAH,SSQ.ICF.DET,NOU  M.I  PR,  IFC)      LEAST006 

C  LEAST007 

CMMi'BN  ALAB,BM,DUM.CY,  IX,PART  ,PG,P,SP.»,X,YC,Y,2  LEASTOOe 

C  LEAST009 

DIMENSION  ALAB(12),  6M(20.21),  OUKdOO).  CY(500),   I  X  (  20  )  ,  P  A  fi  T  (  20  )LE  AS  T  0  I  0 

X.  ,PG(20),  P(20),  SP(20),  *(500).  X<5.500).  YC  (  500  )  ,  Y  t  SOO  )  ,  Z  (  5  )LE  AST  0  1  1 

C  LEAST0I2 

C  THE  AaavE  C0»«M0N  AND  OlMENSIBN  STATEMENTS  WLST  BE  PRESENT  IN        LEAST013 

C  EACH  0F  THF  SLBR0UTINES  IN  THIS  PACKACE  ANC  IN  THE  SUBRBUTINE  YP   LEASTOM 

C  WHICH  THE  USER  SUPPLIES  AS  WELL  AS  IN  THE  MAIN  PRBGRAM  WHICH  USES  LEAST015 

C  THt-rsE  SUHR0UTINES.    THE  0Rr!ERING  eF  THE  CevyZN  MUST  BE  IDENTICAL.  LEAST016 

C  LEAST0I7 

C       weANING  0F  THE  ARGUMENTS  LEAST018 

C  LEAST019 

C  N          CeN0TES  THP  NUMBER  0F  P0INTS  IN  A  PARTICULAR  PRBBLEM.       LEAST020 

C  THIS  MUST  OE  L.T.  0R  F.  Q .   Te  lOOOC+lCOR.   (SEE  F0eTNeTE..     LEAST021 

C  IK         CENaRES  THE  NUMBER  0F  PARAMETERS  IN   A  PARTICULAR  PR 0eLEM .LE ASTO 22 

C  THIS  MUST  BE   LT  eR  EC  TH  lOS+T.   (SEE  F00TN0TE).              LEAST023 

C  IM         CEN0TES  THE  NUMBER  0F  PARAMETERS  THAT  ARE  HELD  FIXED  FBH  ALEAST02A 

C  PARTICULAR  PRUBLEM.  MUST  66  LT  0R  EC.  T0    IK.                 LEA5T025 

C  M          DENOTES  THE  NUMBER  0F  INDEPENDENT  VARIABLES  ACTUALLY  BE  I NGLE AS T 026 

C  USED  IN  A  PARTICULAR  FH0BLEM.  MUST  BE  LT  KR  EQ  T0  U.   ( SEE )LE AST02 7 

C  TEST      CENaRES  A  NUMBER  SUCH  THAT  WHEN  ALL  PARAMETERS  AFTER  SKME  LEAST02e 

C  NUMBER  0F  ITERATI0NS  HAVE  CHANGED  EY  LESS  THAN  TE ST , CBNTRBLE AST  029 

C  IS  RETURNED  MA     THE  CALLING  PH0GRAM.                              LEAST030 

C  WVAR      DEN0TES  THE  WEIGHTED  VAHIENCE.                                     LEAST031 

C  SSO       CGN0TES  THE  SUM  0F  THE  SQUARES  0F  THE  UNWEIGHTED  RES  I DU ALSLE AS T 0 32 

C  IDF       DENOTES  THE  NUMBER  aF  -DECREES  0F  FREED0M-.                    LEAST033 

C  DET       DEN0TES  THE  VALUE  0F  THE  DETERMINANT  0F  THE  N0RMAL  E CU A T  1 0LE AS T 0 3 A 

C  IPIJ        IF   IPR  IS  GT  ZER0  THE  ARRAY  -ALAB-  (LABEL)   IS  WRITTEN  0UT  LEAST035 

C  0N  TAPE  e    AS  WELL  AS  PR0eKAM  ITERATKNS  AND  FINAL  M A T R  I CESLE AS T 036 

C  NOUM      IF   IPR  IS  GT  ZERa  »ND  NDUM  IS  GT  ZERe  THEN  NOUM  ITEMS       LEAST037 

C  FRaM  OUM  A,7SAY  ARE  WRITTEN  0N  TAPE  6                             LEASTC3e 

C  IFG       C0NTR0L  aF  ALGERBRAIC  SIGN  0F  THE  PARAMETER  SET.              LEAST039 

C  IF   IFG=0  Na  SIGN  CHANCE  FBR  ANY  PARAMETER  F0R  5   I T E R A T I BNSLE AST040 

C  IS  ALL0WEO.    THEN  SIGN  CHANGES  ARE  PERMISSIBLE.               LEAST041 

C  IF   IFG=1  SIGNS  ARE  ALWAYS  FREE  T0  CHANCE.                       LEAST042 

C  IF  IFG=2  SIGNS  ARE  NEVER  FREE  T0  CHANCE.                        LEAST043 

C  LEASTO** 

C  LEAST045 

C  LEASTOAe 

c     FaaTNurc meaning  ^F    c,   R,   s.   t,   u leasto47 

C  LEAST04e 

C  lOCOO* 100R=MAXIMUM  NUMEER  fF     DATA  F0INTS.  AS  SET  UF  HERE     LEAST049 

C  0=0,  R=5.    MAXIMUM  DATA  FeiNTS  IS  500.              LEAST050 

C  1CS+T=MAXIMUM  NUMEER  «F  PARAMETERS.  AS  SET  UP  HERE           LEAST051 

C  S=2,    T=0.    MAXIMUM  IS  20.                                  LEAST052 

C  U  =  MAXIMUM  NUMBER  f.F     INDEPENDENT  VARIABLES.  AS  SET  UP  HERE  LEAST053 

C  U=5.                                                         LEAST054 
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FURTHERMORE  

TH0SE  VARIAQLES  N0T  VENTIeNED 
DEFINfcC  IN  THE  F0LL0V(ING  MANNE 

BM      DEN0TES  THE   INVERSE  BF  1 

DUM     A  DU^'MY  SET  0F  NUMBERS  C 

THESE  MAY  BE  USED  FBR  TE 

DESIEO  BY  THE  PRBGRAyMEB 

EVEN  TH0UGH  THEY  ARE  NKT 

DY      CEN0TES  THE  RESIDUALS  ( 

IX  CEN0TES  THE  SERIAL  NUME 
FIXED  F0R  A  PARTICULAR  F 
yuST  BE  EQUAL  T0  IK.   ( SE 

PC      CEN0TES  THE  FINAL  VALUES 

VALUES  OBTAINED  SUCH  THA 

SP      CEN0TES  THE  STANDARD  OEV 

W       DEN0TES  THE  WEIGHTS  ASSf 

X  DEN0TES  THE  INDEPENDENT 
J    TH  INDEPEOENT  VABIABL 

YC      DENOTES  RHE  VALUES  0F  TH 
WITH  THE  FINAL  VALUES  0F 
Y       DENOTES  THE   DEPENDENT 

EXAMPLE  FOR  USE  0F  IX..   IF  IT 
6TH  PARAMETERS  IN 
IX(2)=5.  AND  IX(3 


SPECIFICALLY  AS  ARGUMENTS  ARE 


LEAST  SOU 
lED  THR0U 
NG  ,C0MPAR 
FACE  FOR 
EC. 

YC   >. 
•  OF  PARA 
LEM.    THE 
XAMPLE   G 

THE  PARA 
HE  CeNDIT 
ION  OF  TH 
TED  WITH 


ES  MATRI 
OUT  THE 
G,  OR  AN 
UM   MUST 


PROBLEM. 
Y  OTHER 
BE  PB0V 


LE 
PURPOSLE 
ICEC   LE 


:TERS  THA 
rOTAL  NUM 
>EN  AT  BO 
ETERS.  I. 
!N  'TEST' 

PARAMETE 
'E    Y  VAR 

THE  I  TH 


:ING     LE 

'S     LE 

»E).     LE 


T  ARE  BE 
BER  OF  I 
TT0M  HER 
E.,  THOS 

IS  SATISF lEC.LEA 
RS. 
lABLES. 

POINT  F( 


MRIABLES.    THE  I  TH  POINT  FOR  THELE 
IS    X( J, I ) .  LE 

"LNCTION  EVALUATED  FOR  EACH  POINT  LE 
ie     PARAMETERS.  LE 

UABLES.  LE 


DESIRED  T( 
PROBLEM  . 


FIX  THE 
;et   IM=3 


2ND,5TH, 
.   IXC  1  )  = 


DIMENSION  AM(20 

.20 ) .    DPC20) . 

10C5 

FOHMAK  ///  1  15H 

' 

loce 

F0RMAT(I5.1P£ei7.7/(lPE21.7,lF 

10C7 

F0RMAT( IH+lPlEl 

19.7//) 

10C8 

F0RMAT( 24HCVALUE  0F  DETERMINAN 

locq 

F0RMAT(56H     I 
I//  ) 

1010 

FORMAT ( IHO ) 

lOl'. 

F0RMAT( IHl ) 

101<5 

F0RMAT{ /// 16, 

ITS  =  0 

IHSP=0 
M25C=0 

IIH  ITERATieNS) 

1  1  25 

LA=XL0CF(AM< 1. 1 

)  ) 

LB=XL0CF(BM( 1. 1 

)  ) 

IA=XL0CF(AM( 1. I 

)  )-XL0CFCAMC  1  .2 

IB=XL0CF(BM( 1 ,1 

)  )-XL0CFC8MC  1  ,2 

SENSELIGHT  0 

VAN  =  0.0 

SS  =  CO 

LIES=0 

1  ICO 

DO  110  1   1  =  1  .  IK 
DP{ I )=0.0 
PC(  I  )=PG(  I  ) 
BMC  I.l  )  =  CO 

PCC20)  .    ANC20) 


7.7)  ) 
IP1E14.7/ 


LE 
LE 
LE 
LE 
LE 
ACK.L)  LE 
BCK  )//)LE 
LE 
LE 
LE 
INVERSE  OF  ACK.DLE 
LE 
LE 
LE 
LE 


AST055 
ASTOSe 
AST057 
AST058 
AST059 
AST060 
ASTOei 
AST062 
AST063 
AST064 
ASTOeS 
AST066 
AST067 
ASTOee 
AST069 
ST070 
AST071 
AST072 
AST073 
AST074 
AST07i, 
AST076 
AST077 
AST07e 
AST079 
AST080 
AST081 
AST0e2 
AST0e3 
AST084 

ASToee 

AST086 
AST087 
AST088 
AST089 
AST090 
ASTC91 
AST092 
AST093 
AST094 
AST09S 
AST096 
AST097 
AST09e 
AST099 
ASTIOO 
ASTlOl 
AST102 
ASTI03 
AST104 
AST105 
AST106 
AST107 
AST108 
AST109 
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280CC 


280C2 
200C3 
JBCO 


SP( I )=C.O 

P(  I  )=PG(  I  > 

LIT  =  C 

LIE  =  0 

CHANGES  F0rt  7C90... 

IF(  IPR  )51  .ei  .219';7 

V»RITef?LTPljTTAPE6.2eOCO.(ALAe(Jl).JI=:I,12) 

F^}P<^«AT(  i2Ae) 

VtWITE     0LTPLT     TAPE     6.     28001.     NCLV 

FHHH«AT(//ICH  THERE  ARE  lA.  381-  ENTRIES  FeR  THE  VAfilAELE  CALLED 
CM-  ) 
IF(NCUW)  28004.  28004.  28CC2 

V»I-(ITE  0UTPLT  TAPE  6,  28003.   (  I  .DL>' (  I  )  .  I  =  1  .  NCUK  ) 
F0KMAT(/(<i(ee      DLM(I3.  3H  )  =  F  I  4  . 0  )  )  ) 
wWITE  eLTPLT  TAPE  6,  52.  TEST 

F0^eyAT( //e»-  test  =  ipeis.?///) 

LICK  =  0 


IF(K)   11C2.   1  101  I.  1 

11032 

lion 

LIES  =  1 

Gt)  Tfl  11087 

11022 

0011081=1. K 
Oi 1 108J=1 .KP 

IF( J-KP)  1104.1105,  1 

1105 

1  1C4 

AM( l.J)=C.C 

1  ICS 

IF( I*l-J) 1 lOe, 1 107, 

,  1  106 

1  1C6 

BMC  I , J )=0.C 
G0T011O8 

1  1C7 

BM( I.J )=I.C 

1  ice 

C0NTINLE 
t-  =  l.C 

1  1067 
I  10fc4 

tc 

llOfcE 
1  1  0  E  f. 


I  1  IC 

9CC2 


0021 122L=1 .N 

00  11084  J  =  I.  y 

Z( J )  =  X( J.L  ) 

CALLYPI YT.L.N.M, IK  ) 

IF(LIES)  1 ICae, 1 1086.  1115 

JACK=0 

D09OO3JljK=  I.IK 

IF(  IM)  1  1C2,9C02.5001 

D0  1  1  IC J0Kg  =  l  ,  IM 

IF(JOK-IX(J0KE))111O. 11131. IIK 

C0NT INLt 

JAKE=JLK-JACK 

AN(JAKe)   =  PAHT(JtK) 

G0  T0  9003 

JACK=JACK*1 


90C3 

C0NT INLE 

1115 

YC(L)  =  YT 

DY(L)  =  Y(L)  -  YC(L) 

IF(LIES)21  1  le. 211  16.31  I 

3  1117 

VAt<  =  VAH  +  l»(L»»aY(L)»«2 

SS  =  SS  +  OY(L  >««2 

LEASTUO 
LEASTlll 
LEAST112 
LEASTl 13 
LEAST114 
LEAST115 
LEASTl 16 
LEASTl 17 
LEASTl 18 
-0ULEAST119 
LEAST120 
LEAST121 
LEAST122 
LEAST123 
LEAST124 
LEAST125 
LEAST126 
LEASTI27 
LEASTlZe 
LEAST129 
LEASTISO 
LEAST131 
LEAST132 
LEAST133 
LEAST134 
LEAST135 
LEAST13e 
LeAST137 
LEASTISB 
LEAST13S 
LEASTI4C 
LEAST141 
LEASTM2 
LEAST143 
LEAST144 
LEAST145 
LEASTl4e 
LEAST147 
LEAST148 
LEAST149 
LEASTISO 
LEAST151 
LEAST152 
LEAST153 
LEAST154 
LEAST155 
LEASTlSe 
LEASTI57 
LEAST158 
LEAST159 
LEAST160 
LEASTie 1 
LEAST162 
LEAST163 
LEAST  164 


-  351   - 


LE*ST  -  N0M-LINEAR  LEAST  SCOAKES  ReUTINE  -  FBBTRAN  II  C0CEC 

GH  T0  21122  LEASTiee 

211ie   IF(K ) 1 102.21 122. 1 1 1 7  LEASTieC 

1117  0011221=1. K  UEASTie.? 

00  1122  j=r.KP  LEASTiee 

IPC J-KP ) 1 1 18. 1 1 ig. 1 1 IQ  LEAST169 

lilt;  AM(  I  ,  J  )=AM(  I  ,  J  )+AN(  1  )»AN(  J)«l»(L)  LEAST170 

GH  r«   1122  LEAST171 

1  1  1<;  0M(  I  .  1  )=HM(  I  .  1  )  +  AN(  I  )»DY{L  )»V»(L)  LEAST172 

1  li2  C0NT INUS  LEA5T173 

211^2  CUNTINUe  LEAST17A 

V  =  0.0  LEAST175 

00  eO  L  =  l.N  LeAST176 

to  V  =  V  ♦  *(L)  •DY(L)  •»2  LEAST177 

IF  (LIES)  21128.  21128.   1153  LEASTWe 

211?e   IH  (K  -   1)  21129.  21129.  31122  LEAST179 

31123  0H31124  J=2.K  LEASTieC 
JIG  =  J  -  1  LEAST181 
Ci9     3112a   Irl.JIG  LEAST182 

31124  AM(J,I)  =  AM(I.J)  LEASTie3 
2112q  IF  (K)  1102.  1123.  11221  LEASTISA 
112^1   IF(  SENSfUGHT  1  )  I  123.11251  LEASTIOS 

11J3  SENSELIGHTl  LEASTiee 

WKITe0LrPUTTAPe6.2aCOO.(ALAB( Jl ).J1=1.12)  LEASTie7 

IF  (K)   11C2.   1152,  21123  LEAST188 

C       CHANCES  F0l^  7C90...  LEASTie9 

21123   IF(  IPR  )  1  125 1 .  1 125 1  .21 148  LEAST190 

2114e  WklTE0LTPUTTAPt6. 1005  LEAST191 

0011241=1. K  LeASTI92 

WKl  TE0LTPUTTAPe6.1OOe.  I.(A»>(I,J),J=1,K)  LEASTI93 

1124  *kITE0LTPLTTAPe6,lOO7,8M( I )  LEASTISA 

112t;i   IF(LIE)   1102.  60CC.7000  LEAST195 

60CC  KT  =   1  LEAST196 

G0  TH  eOCC  LEAST197 

70C0  KT=KP  LEASTige 

HOlO  if  (K  -  1)   1152.  3CC0.  AOCO  LEAST199 

30CC  CET  =  AM(l,l)  LEAST200 

HMCl.l)  =  BMt  1 . 1  )/AM(  1  ,  I  )  LEAST201 

HM(1.2)  =   l.O/AM(l.l)  LEAST202 

G0TIZ1131  LEAST203 

40CC  CALL  LEQDC AM.BM.K.KT.I A, IB ,DET )  LEAST204 

C       CHANGES  F0hl  7090...  LEAST205 

li:-l   IF(  SENSELIGHTl  )  1  132.  1  133  LEAST20e 

1132  WKITE0UTPUTTAPE6. 1008.OET  LEAST207 

SENSELIGFIl  LEASTZOa 

li:-3  JUK  =  C  LEAST209 

D0   11351   1=1 . IK  LEAST210 

I4?.?i;  IF  (IM)  11C2.  11343.  11331  LEA5T211 

113;-1  C0  1  1  34  J0Kt  =  l  ,  IM  LEAST212 

IF(  I  -   IX(J0KE))   1134,   11352.  1134  LEAST213 

li;-4  C0NTINUE  LEAST214 

11343  JAKE  =   I  -  JLK  LEAST215 

IF (IFG-1)27CC2. 22353. 6661  LEAST216 

270C2  Ir( I r-5 )eeei .6661 .22353  LEAST217 

66tl  OP(I)  =  P^'(JAKH.      1)  LEAST2ie 

16etf  PC(I)  =  PCI)  +  H«       OPtI)  LEAST219 
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C       CHANGES  FUR  7090...  LEAST220 

IFISENSELIGHTl )7777, 26666  LEAST221 

i-bete   IF(  IFG-n270CC.  I  1351  .6667  LEAST222 

270CC  IF( IT-S )ee67, £667. 1 1351  LeAST223 

7777  SENSELIGHTl  LeAST224 

G0T011351  LeAST225 

66t7  IF(P(  I  )«PC(  I  )  )66ee,  1  1351  .   11351  LEAST226 

66te  y     =  H/2.C  LeAST227 

IF  (h  -  C.COCOOOCOOl  )  12352.    16646.  16666  LEAST22e 

11352  JUK  =  JUK  ■»   1  LEAST229 

11351  C0NTINUE  LEAST23C 

G0  T0  1139  LEAST231 

22353  IF(  IT-25)ee61  .666  I  , 13000  LEAST232 

130CC  ITS=IT  LeAST233 

11341   IF( AaSF(OP(  I  )  )  -  AHSF{BM(  JAKE  .  I  )  )  )  113A2.   11342.  6661  LEAST234 

113A2  H  =  I-/2.C  LEAST23S 

IF(h-.CC0CC0C00n  12352. 6661. etei  LeAST236 

12352  IHSP=1  LEAST237 

G0T011C2  LEAST238 

11J<;  IFCSENSELlGhTl  )  1  147.1  14C  LEAST239 

ll'iO  G0T01142  LEAST24C 

C       CHANGES  FHH  7C90...  LEAST241 

lli.2  IF(  tPH)  1  145.  I  145,  1  143  LEAST242 

1M3  WRI TeHLTPLTTAPE6, 1 3100. I T .H.V  LEAST243 

lllCO  FDWIVAK  IHCl  3,  1P2E  1  7.7)  LeAST244 

D01144I=1,1K  LeAST245 

1144  WR ITe«LTPLTTAPE6. 10C6.  ( I  .PG( 1  )  .P(  I  )  .PC (I  )  .CP(  I  )  )  LEAST246 

1145  JERK  =  0  LEAST247 
OH  1146  I  =  I.IK  LeAST24e 
IF  (PtI))   11451.   11452.   11451  LeAST24q 

11451  IF( 4eSF(  (PCI  I  )-P(  I  )  )/P(  I  )  )-  TtST     )   1146.   1146.   1148  LEAST250 

11452  JEKK  =  JERK  ♦  1  LEAST251 

1146  CONTINUE  LEAST252 
IF  (JEHK  -  IK)   1147.   1146.  1146  LEAST253 

1147  SENSELIGHTl  LEAST254 
LIE  =  1  LEAST255 
f/.25C  =  l  LEAST25e 

1146  0011491=1. IK  LEAST257 

1149  P( 1 )=PC( I )  LEAST25e 
IF  (LICK)   HC2.   1150.   1152  LeAST259 

1150  IFCSENSELIGh-Tl  )  1  ISOl  .  1  151  LEAST2e0 
115C1  SENSELIGHTl  LEAST2ei 

LICK  =  1  LEAST262 

1151  IF(M2SC)2976e.297ee.  1 1032  LEAST263 
?07te  IF(  IT-25  )  1  1032.  1  1512.  1  1032  LEAST264 
11512  ScNSELIGKT   1  LEAST265 

IT=C  LEAST266 

ITS=2e  LEAST267 

G»  T0  1147  LEAST2ee 

1152  VArirC.C  LeAST269 
SS=C.0  LeAST270 
LIES  =  1  LEAST271 

G0  TH  1 lCe7  LEAST272 

1152  UF=N-K  LEAST273 

IUF=N-K  LEAST274 
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IF(K  )   1102,  21  155.  21154 

c 

CHANGES  F0R  7C90... 

2115^ 

IF(IPR)2  199e.2199e.2  1ie9 

2  1  ic-g 

WRITe0UTPljTTAPE6,lOO9 

D01155I  =  1  .K 

WRITEHUTPUTTAPEe.lCOe.I  .  (BN(  I 

1  1  S5 

WRITE0LTPLTTAPE6.1O1C 

pig'ie 

IF(  ITS)130C2.  130 04. 13002 

130C2 

IT=ITS 

1  30C4 

WH1TE0LTPLTTAPE6. 1019. !T 

21  lt5 

WVAH   =   VAR/DF 

SbQ  =   SS 

JACK   =   0 

on     2  1160   I  =   I.IK 

IF(  IM)  1  102.  1  158.1156 

1  1  ^fc 

Diil  157J=1.  IM 

IF(  I-IX( J)  )  lis?.  11591  .  lis? 

1  157 

CUNT INOE 

1  lee 

JAKE  =  I  -  JACK 

,J) .J=2.KP) 


I  1  t9   SM(  I 


SGRTF (BM( JAKE ,J)< 


1159  1 

JACK  =  JACK  +  1 

21  lec 

CONTINUE 

1  1C2 

SENSELIGHT  0 

IFtlHSP 122100. 22 108. 22100 

221CC 

WRlTE0LTPLTTAPEf..22  1C2 

221C2 

F0KMAT( 75HCTHE  PRUGHAM  00 

XT   0N  CHANGING   SIGNS) 

221Ce 

HETLRI>I 

ENO 

rERAIlNG  SINCE  TFE  PARAMETER(S) 


LEAST275 
LEAST276 
LEAST277 
LEAST27e 
LEAST279 
LEAST2eC 
LEAST281 
LeAST2e2 
LEAST2e3 
LEAST284 
LEAST285 
LEAST2ae 
LEAST2e7 
LEAST2ee 
LeAST2e9 
LEAST290 
LEAST291 
LeAST292 
LEAST293 
LEAST294 
LEAST295 
LEAST296 
LEAST297 
LeAST29e 
LEAST299 
LEAST300 
LEAST301 
[SUEAST302 
LEAST303 
LEAST304 
LEAST305 
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R01.TINE  F0F1  LEAST  SQUARES  ROUTINE  -  F0RTRAN  II  C0DEO 


CLQINP  LEAST  SQLARES  INPLT  SLBRBLTIKE  NVU  MATH  UTILITY        LQINPOOl 

(-  LQINP002 

SUDf^auTINE  LCINP(N,IK,  IM.y.TEST.NCL^.  IFR,  IFG)  LQINP003 

C  LQINP004 

C       REACS  FH0M  INPLT  TAPE  5  THE  FeLL0»ING  DATA AL AB  AHRARY.  N , I K .LQ I NP005 

C  Il(,.M.IO.ITeST,IDU»',NOLV,IPfl.IFG.IX,PG,Y.X,>il.DLIM,TeST.       LQINP006 

(-  LQINP007 

C       SEE  PR0GRAV  KRITE-LP  0F  LEAST  SQLARES  F0R  INSTRUCTI0NS  0N  LQINPOOe 

C  PREPARATION  0F  INPLT  DATA.  LQINPOO'3 

(-  LQINPOIO 

C0»'l«'0N  ALAB.BM  .DLW  .DY.  IX,PART,PG.P.SP.».X,YC.Y,Z  LQINPOll 

J-  LQINP012 

OIMENSI0N  ALABtlS).  BMt20.2l).  DUCdOO).  DY(500).  I  X  (  20  )  .  PART  (  20  )  LQ  I  NPO  I  3 
X      ,PG(20).  Pt20),  SP(20).  V»(500),  X(5.500).  YC(500).  Y  (  500  )  ,  Z  (  5  )LQ  I  NPO  1  A 


LQINP015 


C  THE  AB0VE  C0WM0N  AND  DIMENSI0N  STATEMENTS  MLST  BE  PRESENT  IN  LQINP016 

C  EACH  0F  THE  SLBR0UTINeS  IN  THIS  PACKAGE  AND  IN  THE  SUBR0UTINE  YP  LQ1NP017 

C  WHICH  THE  LSEH  SLPPLIES  AS  WELL  AS  IN  THE  MAIN  PR0GRAM  WHICH  USES  LQINP018 

C  THESE  SUBR0LTINEE.    THE  0HDeRING  eF  THE  C0MMBN  MUST  BE  IDENTICAL.  LQINP019 


LOINP020 


C       MEANING  0F  THE  ARGLMENTS  LQINP02I 

C  LQINP022 

C  N          CtKBTES  THE  NUMBER  0F  P0INTS  IN  A  PARTICULAR  PR0BLEM,       LQINP023 

C  THIS  MLST  BE  L.T.  BR  EG.   T0  lOOOC+lOOH.   (SEE  F00TN0TE..     LQINP024 

C  IK         CEN0RES  THE  NUMBER  0F  PARAMETERS  IN   A  PARTICULAR  PR 0BLEM.LQ I NP025 

C  THIS  MLST  BE   LT  0R  EC  T0  lOS+T.   (SEE  F00TN0TE).              LQINP026 

C  IM        nEN0TES  THE  NUMBER  0F  PARAMETERS  THAT  ARE  HELD  FIXED  FBR  ALQINP027 

C  PARTICULAR  PR0BLEM.  MLST  EE  LT  0R  EC.  T0    IK.                  LQINP02e 

C  M          DEN0TES  THE  NUMBER  0F  INDEPENDENT  VARIABLES  ACTUALLY  BE  I NGLQ I NP029 

C  LSED  IN  A  PARTICULAR  FR0BLEM.  MUST  BE  LT  0R  EQ  T0  U.   ( SEE )LQ I NP030 

C  TEST      DEN0RES  A  NLMHER  SLCH  THAT  WHEN  ALL  PARAMETERS  AFTER  SBME  LQ1NP031 

C  NUMBER  0F   ITEWATI0NS  HAVE  CHANGED  BY  LESS  THAN  TE ST . C BNTR0LQ I NP032 

C  IS  RETURNED  T0  THE  CALLING  PR0GRAM.                              LQINP033 

C  IPH        IF  IPR  IS  GT  ZFR0  THE  ARRAY  -ALAB-  (LABEL)   IS  WRITTEN  BUT  LOINP034 

C  0N  TAPE  6   AS  WELL  AS  PR0CRAM  ITERAT0NS  AND  FINAL  M A TR  I CESLQ I NP035 

C  NOUM      IF   IPR  IS  GT  ZER0  AND  NDLM  IS  GT  ZERB  THEN  NDUM  ITEMS       LOINP036 

C  FRBM  DLM  ARRAY  ARE  WRITTEN  0N  TAPE  6                             LQINP037 

C  IFG       C0NTR0L  0F  ALGERBRAIC  SIGN  0F  THE  PARAMETER  SET.              LOINP030 

C  IF  IFG=0  N0  SIGN  CHANGE  FBR  ANY  PARAMETER  F0R  5  I TER A T I 0NSLQ I NPO 39 

C  IS  ALL0WEO.    THEN  SIGN  CHANGES  ARE  PERMISSIBLE.               LQINP04C 

C  IF   IFG=1  SIGNS  ARE  ALWAYS  FREE  T0  CHANGE.                       LQINPOAI 

C  IF  IFG=2  SIGNS  ARE  NEVER  FREE  T0  CHANGE.                        LQINP0A2 

C  LQINP043 

Q  LQINP044 

C  LQINP045 

C       F00TN0TE MEANING  BF  0.    R.    S.    T,   U LQINP046 

Q  LQINP047 

C  lC00a*10OR=MAXIMUM  NLMEER  BF  DATA  P0INTS.  AS  SET  UF  HERE     LQINP048 

C  0^:0.  R  =  5.    MAXIMLM  DATA  FBINTS  IS  500.              LQINP049 

C  lCStT=MAXI MLM  NUMBER  KF  PARAMETERS.  AS  SET  UP  HERE           LOINP050 

C  S=2.    T=0.    MAXIMUM  IS  20.                                  LQINP051 

C  L=MAXIMUM  NUMBER  BF  INDEPENDENT  VARIABLES.  AS  SET  UP  HERE  LQINP052 

C  L=5.                                                         LQINP053 

C  LOINP054 
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LQINP055 

C       FURTHERMORE  LQtNP056 

C  THOSE  VARIABLES  N0T  MENTIBNED   SPECIFICALLY  AS  ARCU^'ENTS  ARE        LQINP057 

C       DEFINED  IN  THE  F0LL0HING  NANNER  .LQINP058 

C  LQINP059 

C  BM      OEN0TES  THE   INVERSE  0F  THE  LEAST  SQUARES  MATRIX.                LQINP060 

C  DUM     A  DU^'MY  SET  0F  NUMBERS  CARRIED  THR0UGH0UT  THE  PR0BLEM.         LQINPOCl 

C  THESE  MAY  BE  USED  F0R  TE S T I NG .C BMP AR I NG .  0R  ANY  0THER  PURP0SLQ I NP062 

C  DESIEO  BY  THE  PR0GRANMEB.  SPACE  F0R   OUK   MUST  BE  PROVICEC   LQINP063 

C  EVEN  TH0UGH  THEY  ARE  N0T  USED.                                       LQINP06A 

C  DY      CEN0TES  THE  RESIDUALS  (  Y  -  YC   ) .                                   LQINP065 

C  IX      DENOTES  THE   'SERIAL  NUMEERS •  eF  PARAMETERS  THAT  ARE  BEING     LQINP066 

C  FIXED  F0R  A  PARTICULAR  PROBLEM.    THE  TOTAL  NUMBER  OF  IX'S     LQINP067 

C  MUST  BE  EQUAL  T0  IM.   (SEE  EXAMPLE   GIVEN  AT  BOTTOM  HERE).     LQINP06e 

C  PG      DENOTES  THE  FINAL  VALUES  OF  THE  PARAMETERS.   I.E..  TFOSE       LQINP069 

C  VALUES  OBTAINED  SUCH  THAT  THE  CONDITION  'TEST*   IS  S AT  I SF I ED.LO I NP070 

C  SP      DENOTES  THE  STANDARD  DEvIATIgN  OF  THE  PARAMETERS.               LQINP071 

C  W       DENOTES  THE  oEIGHTS  ASSZCIATED  ViITH  THE   Y  VARIABLES.          LOINP072 

C  X       DENOTES  THE    INDEPENDENT    VARIABLES.    THE  I  TH  POINT  FOR  THELQINP073 

C  J   TH  INDEPEDENT  VARIABLE  IS    X(J.I).                              LQINP074 

C  YC      DENOTES  RHE  VALUES  OF  THE  FUNCTION  EVALUATED  FOR  EACH  POINT  LQINP075 

C  *ITH  THE  FINAL  VALUES  OF  THE  PARAMETERS.                           LQINP076 

C  Y       DENOTES  THE   DEPENDENT    VARIABLES.                                  LQINP077 

C  LQINP07e 

C  EXAMPLE  F0H     USE  0F   IX..   IF  IT  IS  DESIRED  TO  FIX  THE  2N0.5TH.  AND   LQINP07<3 

C  6TH  PARAMETERS  IN  A  PROBLEM  ,  SET    IM=3,   IX(1)=2.      LOINP080 

C  IX(2)=5,  AND  IX(2)=6.                                          LQINPOei 

C  *VAR      DENOTES  THE  WEIGHTED  VARIENCE.                                     LQINP082 

C  SSQ       DENOTES  THE  SUM  OF  THE  SQUARES  OF  THE  UNWEIGHTED  RES  I CU ALSLQ INPOe 3 

C  IDF       DENOTES  THE  NUMBER  OF  -DEGREES  0F  FREEDOM-.                    LQINP08A 

C  DET       DENOTES  THE  VALUE  OF  THE  DETERMINANT  0F  THE  NORMAL  ECU AT  1 0LQ I NP08 5 

C  LQINP086 

10  F0RMAT( 6E12.7 )  LQ|NP0e7 

11  FORMAT  (2«I3)  LQINP088 

12  FORMAT  (6F12.0)  LQINP08<3 
READ INPUTTAPE  S.20C, ( ALAB ( I ) . 1=1 . 12)                                       LQINP090 

2C0  F0fiMAT(12Ae)  LQINP091 

READINPUTTAPE  5.  1  1  .N .  I K. I ».M        , I B ,  I  TEST , I DUM ,                        LQINP092 

XNDUM, IPR, IFG  LQINP093 

IF(M- 1  )77. 79. 79  LQINP094 

77  M=l  LQINP095 

79  READINPUTTAPE  5 .  1 1  . I M ,  (  I  X (  I  )  .  I  =  1  ,  I M )                                       LQINP096 

READINPUTTAPE  5. 10 . (PG( I ) ,1=1 .IK)  LQINP097 

IF  (IB  -  1)  e.  20,  20                                                          LQINP09e 

e  READINPUTTAPE  5 .  1  0  ,  ( Y (  I  )  .  I  =  1  . N )                                              LQINP099 

D07J=1,M  LQINPIOO 

7  READINPUTTAPE  5 , 1 0 . ( X (  J , I  )  , I  =  1 ,N )  LQINPIOI 

IF(  I* )3.3.A0  LQINP102 

to     IF{  IW- 1  ) A. A.42  LQINP103 

42  IF( IW-2) A3.43, A5  LQINP104 
4E  De47I=l,N  LQINP105 
47  W(  I  )=l./( Y(  I  )»«2)  LQINPlOe 

GOTOe  LQINP107 

43  00441=1, N  LQINPI08 

44  •(  I  )  =  1 ./Y(  I  )  LOINP109 
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C0Ta6  LQINPllO 

3  D05I  =  l .N  LQINPl I  1 
£  »( I >= I.  LQINPII2 

G0  T0  6  LQINP113 

4  REAC INPUTTAPE  5 . 1 0 • ( * ( I ) . I = 1 . ^ )  LQINPI14 
Ga  10  6  LQINP115 

20  00  Z3  1  =l,H  LQ INPl 16 
IF(  I*- 1  )21  .22.24  LQINP117 

24  IF( IW-2)2E.2E.27  UQINP118 
27  REAOINPOTTAPE  5 .  1 0  ,  Y (  I  ) ,  (  X ( J ,  I  ) . J= 1 , M )  LQ1NP119 

w(  I  )=I./( Y(  I  )«»2)  LOINP120 

G41T023  LQINP121 

25  READINPLTTAPE  5 .  1 0  .  Y ( I  )  .  (  X ( J  ,  I  )  , J= I  . M )  LQINP122 
W(  I  )  =  1  ./Y(  I  )  LQINPI23 
GHT023  LQINP124 

21  REACINPUTIAPE  5.  1C.Y(  I  )  ,  <  X{  J.  I  )  ,  J=l  .M)  I.QINP125 
Mil)  =  1.0  L0INP126 
G0  T0  23  L01NP127 

22  REACINPUTTAPE  5  .  1  0  .  Y  (  I  )  ,  {  X  (  J  .  I  )  .  J  =  1  .  f*  )  ,  •  (  I  )  L0INP12e 

23  C0NTINUE  L0INPl2q 
6  IFCICUM  -  1)  31.  30.  30  LQINP130 

20     REACINPUTTAPE  5 .  1 2 . ( DU^ (  I  )  .  I  =  1  .  NDL ^ )  LQINP131 

jl   IF  (ITEST  -  1)  32.  33.  33  LQINP132 

32  TEST  =  O.OCOOOl  LQINP133 
G0  T0  100  LQINP134 

33  REACINPUTTAPE  5. 10. TEST  L0INP135 
ICO  RETURN  LQINP136 

END  LQINP137 
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CLOeUT  LEAST  SQUARES  0(jTPUT  SUBRBUTINE  NYU  MATH  UTILITY        LQ0UTOOI 

C  LQ0UTOO2 

SueR0UTINE  LO0LT(N,IK. IM.M.MVAR.SSO.IOF)  LO0UTOO3 

C  LQBUT004 

C  WRITES  0LT  RESULTS  FR0M  LEAST  SUBR0UTIKE  0N  TAPE  6.   MUST  BE        LO0UTOOS 

C  CALLED  AFTER  THE  CALL  T0  LEAST.                                              LQ0UTOO6 

C  LQ0UTOO7 

C0^'M0N  ALA8.BM.0UM  ,0Y.  IX«PART.PG«P>SP>lt<X.YC>V.2  LO0UTOO6 

C  LQBUT009 

DIMENSt0N  ALABdZ).  BM(20.21).  OUM(tOO).  CY(SOO).   I  X  (  20  )  .  PART  (  20  )LQ0UTO  I  0 

X  ,PG(20).  P(20).  SP(20).  M(SOO).  X(5.500).  YC(500).  Y ( 500 ) . Z ( 5 )LO0UTO I  1 

C  LO0UTOI2 

C  LQ0UTO13 

C  THE  AB0VE  C0MM0N  AND  DIMENSI0N  STATEMENTS  MUST  BE  PRESENT  IN        LQ0UTO14 

C  EACH  0F  THE  SLBR0UTINES  IN  THIS  PACKAGE  AND  IN  THE  SUBROUTINE  YP   LQ0UTOI5 

C  WHICH  THE  USER  SUPPLIES  AS  WELL  AS  IN  THE  MAIN  PRBGHAM  WHICH  USES  LQ0UTO16 

C  THESE  SUBROUTINES.    THE  ORDERING  OF  THE  COMMON  MUST  BE  IDENTICAL.  LQ0UTO17 

C  LQOUTOie 

C       MEANING  OF  THE  ARGUMENTS  LO0UTOt9 

C  LQ0UTO2O 

C  N          DENOTES  THE  NUMBER  OF  POINTS  IN  A  PARTICULAR  PROBLEM.       LQ0UT021 

C  THIS  MUST  BE  L.T.  OR  EG.   TO  ICOOQ+IOOR.   (SEE  FOOTNOTE..     LQ0UTO22 

C  IK         CEN0RES  THE  NUMBER  0F  PARAMETERS  IN   A  PARTICULAR  PROBLEM. LQ0UT02 3 

C  THIS  MUST  HE   LT  0R  EC  TO  lOS+T.   (SEE  FOOTNOTE).              LQ0UTO2A 

C  IM         DENOTES  THE  NUMBER  OF  PARAMETERS  THAT  ARE  HELD  FIXED  FOR  ALQOUT025 

C  PARTICULAR  PROBLEM.  MUST  BE  LT  OR  EC.  TO    IK.                 LQ0UTO26 

C  M          DENOTES  THE  NUMBER  OF  INDEPENDENT  VARIABLES  ACTUALLY  BE  I NGLO0UT02 7 

C  USED  IN  A  PARTICULAR  PROBLEM.  MUST  BE  LT  OR  EQ  TO  U.   ( SEE )LQ0UT02e 

C  WVAR      DENOTES  THE  WEIGHTED  VARIENCE.                                     LQ0UTO29 

C  SSO       DENOTES  THE  SUM  OF  THE  SQUARES  OF  THE  UNWEIGHTED  RES  I DUALSLO0UT030 

C  IDF       DENOTES  THE  NUMBER  OF  -DEGREES  0F  FREEDOM-.                    LQ0UTO31 

C  LQ0UTO32 

C  LO0UTO33 

C  LQ0UTO3A 

C       FOOTNOTE MEANING  OF  0.    R,    S.    T.   U .  .  .  . .  .LO0UTO3S 

C  LQ0UTO36 

C  lCOCQtlOOR=MAXIMUM  NUMBER  OF  DATA  POINTS.  AS  SET  UP  HERE    LQ0UT037 

C  0=0.  R=5,    MAXIMUM  DATA  POINTS  IS  500.              LOOUT03e 

C  ICS*T  =  MAXt  MUM  NUMBER  OF  PARAMETERS.  AS  SET  UP  HERE           LQOUT03<3 

C  S=2.    T=0.    MAXIMUM  IS  20.                                  LQ0UTOAC 

C  U=MAXIMUM  NUMBER  OF  INDEPENDENT  VARIABLES.  AS  SET  UP  HERE  LO0UTO41 

C  U=5.                                                         LQ0UTOA2 

C  LQ0UTO43 

C       FURTHERMORE LQ0UTO44 

C  THOSE  VARIABLES  NOT  MENTIBNEO   SPECIFICALLY  AS  ARGUMENTS  ARE        LQ0UTO45 

C       DEFINED  IN  THE  FOLLOWING  MANNER  LO0UTO46 

C  LQ0UTO47 

C  BM      DENOTES  THE  INVERSE  OF  THE  LEAST  SQUARES  MATRIX.                LOOUTOAB 

C  DUM     A  DUMMY  SET  OF  NUMBERS  CARRIED  THROUGHOUT  THE  PROBLEM.         LQ0UTO49 

C  THESE  MAY  BE  USED  F0R  TE ST  I NG .C BMP AR I NG  .  OR  ANY  OTHER  PURPBSLQ0UT05O 

C  DESIED  BY  THE  PROGRAMMER.  SPACE  F«R   DUM   MUST  BE  PROVIDED   LOOUT051 

C  EVEN  THOUGH  THEY  ARE  NOT  USED.                                       LQ0UTO52 

C  DY      DENOTES  THE  RESIDUALS  (  Y  -  YC  ) .                                   LQ0UT053 

C  IX      DENOTES  THE  'SERIAL  NUMBERS'  OF  PARAMETERS  THAT  ARE  BEING     LQ0UTO54 
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C               FIXED  F0R  A  PARTICULAR  FRBBLEH.    THE  TBTAL  NUMBER  0F   IX'S  LQ0UTO55 

C               WUST  BE  EQUAL  T0  IM.   (SEE  EXAVPLE   GIVEN  AT  BeTT0M  h-ERE  )  .  LO0UTO56 

C  PG  CEN0TES  THE  FINAL  VALUES  0F  THE  PARAMETERS.  I.E..  Tt-BSE  LQ0UTO57 
C               VALUES  0BTAINED  SUCH  THAT  THE  CaNOITIBN  "TEST*   IS  S AT  I SF I  ED .LQ 0UTO58 

C       SP      DEN0TES  THE  STANDARD  OEVIATIBN  0F  THE  PARAMETERS.  LQ0UTO59 

C  W  CEN0TES  THE  WEIGHTS  ASS0CIATEO  KITH  THE  V  VARIABLES.  LQ0UTO6O 
C       X       CEN0TES  THE    INDEPENDENT    VARIABLES.    THE  I  TH  P0INT  F0H  THELQ0UTO61 

C               J    Tt-   INDEPEDENT  VARIABLE  IS   X(J.I).  LQ0UTO62 

C       YC      CEN0TES  WHE  VALUES  0F  THE  FLNCTIZN  EVALUATED  F0R  EACH  P0INT  LQ0UTO63 

C               WITH  THE  FINAL  VALUES  0F  THE  PARAMETERS.  LQ0UTO64 

C       Y       CEN0TES  THE   DEPENDENT    VARIABLES.  LQ0UTO65 

C  LQ0UTO66 

C       EXAMPLF  F0R  USE  0F   IX..   IF  IT  IS  DESIRED  T0  FIX  THE  2ND.5TH,  AND  LQ0UTO67 

C                        eTH  PARAMETERS  IN  A  PR0HLEM  ,  SET    IM=3,  IX(l)=2.  LQ0UTO68 

C                        IXt2)=5.  AND  IX(3)=6.  LQBUTOeq 

C  LQ0UTO7O 

C  TEST  OEN0RES  A  NUMBER  SUCH  THAT  WHEN  ALL  PARAMETERS  AFTER  S0ME  LQ0UTO71 
C                 NUMBER  0F   ITERATIBNS  HAVE  CHANGED  BY  LESS  THAN  TE ST , C0NTR0LQ0UTO 72 

C  IS  RETURNED  T0  THE  CALLING  PRBGRAM.  LQ0UTO73 
C       DET       CtN0TES  THE  VALUE  0F  THE  DETERMINANT  aF  THE  N0RMAL  ECU AT  1 0LQ0UT 0 74 

C  IPH  IF  IPH  IS  GT  ZER0  THE  ARRAY  -ALAB-  (LABEL)  IS  WRITTEN  BUT  LQ0UTO75 
C                 0N  TAPE  6    AS  WELL  AS  PR0GRAM  ITERAT0NS  AND  FINAL  M A TR I CESLQ 0U TO  76 

C       NDUM      IF   IPR  IS  GT  ZER0  AND  NDUM  IS  GT  ZERB  THEN  NDUM  ITEMS  LQ0UTO77 

C                 FR0M  CUM  ARRAY  ARE  WRITTEN  0N  TAPE  6  LQ0UTO7e 

C  IFG  CCNTRBL  0F  ALGERBRAIC  SIGN  0F  THE  PARAMETER  SET.  LQ0UTO7g 
C                  IF  IFG=0  N0  SIGN  CHANCE  F0R  ANY  PARAMETER  F0R  5  I TER A T I 0NSLQ 0UTOeO 

C                  IS  ALL0WEO.    THEN  SIGN  CHANGES  ARE  PERMISSIBLE.  LQ0UTOei 

C                  IF  IFG=I  SIGNS  ARE  ALWAYS  FREE  T0  CHANGE.  LQ0UTOe2 

C                  IF   IFG=2  SIGNS  ARE  NEVER  FREE  T0  CHANGE.  LO0UTOe3 

C  LQ0UTOa4 

DIMENSI0N   RP(20).  AN(20.20)  LOBUTOBS 

C  LQBUTOee 

WRITE0UTPLTTAPE6. 28000, (ALAB{jn.Jl=l. 12)  LQ0UTOe7 

280C0  F0RMAT(12A6)  LOBUTOSS 

ITCHY  =  0  LQ0UTO8g 

00  198  I  =  I.IK  LQ0UTC9O 

IF  (IX{I)  -  I)   1<39.   198.   199  LOeUT091 

198  C0NTINUE  LQ0UTO92 

ITCHY  =  1  LQ0UTO93 

1S9  I  =  -1  LQ0UTO94 

CALLYPC YT. I .N.M. IK )  LQ0UTO95 

68  IF  ( IM)   1,   1.   2  LQ0UTO96 

1  IM  =  0  LQ0UTO97 

2  WRI TE0UTPUTTAPE6, 101  I  .N.M. IK.IM.WVAR.SSQ  LQ0UTO9e 
1011  F0HMAT(////23H  THIS  PRBBLEM  CBNTAINS  I3.14H  DATA  P0INTS.   12.  LO0UTO99 

130H  INDEPENDENT  VARIABLE(S).  AND  I2.15H  PARAMETER(S)   (12.  LQ0UTIOO 

224H  0F  THEM  HELD  C0NSTANT).//  LQ0UT1O1 

326H  THE  WEIGHTED  VARIANCE   IS  1 PE 1 4 . 7 .  LQ0UT1O2 

456H  AND  THE  UNWEIGHTED  SUM  0F     SQUARES  0F  THE  DEVIATIONS  IS  I PE 1 4 . 7LQ 0UT 1 03 

5, IH. /////)  LO0UT1O4 

WRITE0UTPUTTAPE6. 1 015  LQ0UT1O5 

JACK  =  0  LQ0UT1O6 

D01ie4I=l.IK  LQ0UT1O7 

IF(  IM)  1  ISe.  1 158. 1  156  LQPUTlOe 

1156  D01157J=I,IM  LQ0UT1O9 
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1F(I-IX(J))1157.11E91.1157  LQ0UT11O 

11£7  C0NTINUE  LQ0UT111 

llSe  JAKE  =  I  -  JACK  LOauTllS 

J  =  JAKE  +  1  LO0UTH3 

ll£9  C0NTINUE  LO0UTH4 

G0  T0  21ie0  LO0UT11S 

11591  JACK  =  JACK  +   1  LQ0UTU6 

21ie0  WHITE0bTPUTTAPE6,lOO6t I  .PG( I  )  .P(  I  )  .SP( I )  LQ0UT117 

IF  (ITCHY)   1160,   1160.   11621  LQ0UT118 

lieO  IF  (IM)   11621.   11621.   1161  LQ0UT1I9 

1161  D01162J=1.IM  LQ0UT12O 
IF{I-IX(J))1162.1163.1162  LQ0UTI21 

1162  C0NTINLIE  LQ0UT122 
116Z1  A  =  0.0  LQ0UT123 

C  =  0.0  LQ0UT124 

Ca  901  JBE  =  l.N  LQ0UT12S 

D0  900  JUMP  =   l.iw  LQ0UT126 

9C0  Z(JljMP)  =  X(JUMP.J0E)  UQ0UT127 

7C6  CALLYPC YT. J0E .N.y . IK )  LQ0UT12e 

A  =  A  ♦  \«(J0E)  »  YC(J0E)   •  PARTII)  LQ0UT129 

9C1  0  =  B  ♦  w(J0E)  •  Y  (J0E)  •  PABTII)  LQ0UT13O 

*R ITe0UTPUTTAPE  6.  9C2.  A.  B  LQ0UT131 

9C2  F0HMAT ( 1H+ IPE 1 02.7 ,   1PE17.7)  LQ0UT132 

IF  (ITCHY)   1164.   1164.   1163  LO0UT133 

1163  WRITE0UTPUTTAPE6. 1016  LQ0UT134 

1164  CONTINUE  LQ0UTI3S 
10C6  F0RVAT (  14.  lP5t 17.7/(  1PE21  .7,  1F4E 1 7.7)  )  LQ0UT136 

1015  F0RMAT(lieH  GUESSTIMATE  0F  FINAU  VALUE  0F  S.C.  0F  LQ0UT137 
1  EXACT  LEAST  SQUARES  ECUATIBNS/  LQ0UT13e 
21ieH  K  K-TH  PARAMETER  K-TH  PARAMETER  K-TH  PARAMETER  LQ0UT139 
3                                   FITTED  FUNCTI0N  INPUT  DATA//)          LQ0UT14C 

1016  F0HMAT(9OH*  TLO0UT141 
IHIS  PARAMETER  WAS  HELD  FIXED.         )  LQ0UTI42 

WRITE0UTPLTTAPE6. 1012  LO0UT143 

1012  F0HMAT(/////47H  MATRIX  0F  C0RRELATI0NS  BETWEEN  FREE  PARAMETERS/)  LO0UT144 
K=IK-IM  LQ0UT145 
00111=1. K  LQ0UT146 
D01CJ=1.K  LQ0UT147 

10  RP( J )=BM(  I  .  J+ 1  )/SQRTF(BM(  I  .  1+ 1  )»BM ( J. J+1  )  )                                LQ0UT148 

11  WRITE0UTPUTTAPE6. 1013.  I . (RP( J)  . J=l  .K)  LQ0UT149 

1013  F0RMAT(  IHO . 14.  14F8.3/(F12.3.  1 2F8.3  )  )  LQ0UT15O 
wHITe0UTPUTTAPE6.2eCCO.(ALAB(Jl).Jl=1.12)  LQ0UT151 
WRITE0UTPUTTAPE6. 1014  LQ0UT152 

1014  F0RMAT(119HO  INDEPENDENT  OEPENDENLQ0UT 1 53 
IT  CALCULATED  STD.  CEV.  0F/  LO0UT154 
2120H  I  HEIGHT  VARIABLE  VARIABLE  LQ0UT155 
3   FUNCTI0N            OEVIATI0N  PREDICTED  MEAN)          L0auT156 

D0  20  I  =  l.N  LQ0UTI57 

O02OOJ=1.M  LQ0UT15e 

2C0  Z(J)=X(J.I)  LQ0UT159 

CALLYP( YT.L.N.M. IK )  LQ0UT16O 

A=0.0  LO0UT161 

JACK=0  LQ0UT162 

D02O5JUK=1  .  IK  LQ0UT163 

IF( IM )203. 203.201  LQaUTl64 
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^01  D02O2J0KE= It IM  LQ0UT165 

IF( JUK-IX( J0KE ))202.204.202  LO0UT166 

2C2  C0NTINUE  LQ0UT167 

2C3  JAKE=JUK-JACK  LQ0UT16e 

AN< JAKE )=PAaT( JUK )  UQ0UT169 

G0Ta2OS  LQ0UT17O 

204  JACK=JACK+l  LQ0UT171 

2C5  CBNTINUe  LQ0UT172 

K=IK-IW  LO0UT173 

DB206J=l.K  LQ0UT174 

D02O6JJ=1.K  LQ0UT175 

2C6  A=A+AN( J )«AN( J J)»BM( J, JJ+ 1 )  LQ0UT176 

A  =  SORTF( A«teVAR  )  LQ0UT177 

J  =  1  LQ0UTl7e 

IF(M-2)300.312.312  LO0UT179 

3C0  MRITE0UTPUTTAPE6< 1020. I .«( I > .X ( 1 . I ) . Y( t ) .YC( I ) .0Y( I )   .    A  LO0UTiaO 

1020  F0RMAT( IH0I5. 1PE17.7.        lPEie.7.  IP3E17.7.     1PE27.7)               LQ0UTiei 

G0T02O7O  LQ0UT182 

312  WRITE0UTPUTTAPe6.  302  .  I  .  VH  (  I  )  .  J  .  X  (  1  .  I  )  .  Y  (  I  )  ,  VC  <  I)  ,  O  Y  (  I  )  .A        LQ0UT183 

3C2  F0RMAT( 1H0I5. 1PE17.7.   13.   1PE15.7,  1P3E17.7.     IPE27.7)               LQHUT184 

2072  00  207  J  =  2,M  LO0UT185 

2C7  v«RITe0UTPUTTAPE  6.   1021.  J.  X(J.I)  LQ0UTie6 

lOil  F0RMAI  (126.   1PE15.7)  LQ0UT187 

207C  IF  (ITCHY)  20.  20.  20H  LQ0UT188 

2Ce  WRITE0UTPUTTAPE  6.  209,   (PART(J).  J  =  I.IK)                              LQ0UT189 

209  F0RMAT(9H  PABTIALS  1 PE I  4 . 7 . 1 P AE 1 7 . 7/ (  1 PE2 3 . 7 . 1 PAE 1 7 . 7 ) )  LQ0UT19O 

kO     C0NTINUE  LQ0UT191 

RETURN  LQ0UT192 

END  LQ0UT193 
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Random  Number  Generator 
1.   RAND0M   Random  Number  Generator  -  PAP  Coded 
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Identification:     RAND0M  -  Random  Number  Function 

7094  -  FAP  Coded 

Purpose:   1)  To  be  able  to  generate  a  floating  point 
number  from  a  sequence  of  random  numbers 
uniformly  distributed  in  the  Interval  (0,1). 

2)  To  be  able  to  reset  the  routine  to  a  given 
point  in  the  sequence  of  numbers. 

3)  To  be  able  to  save  the  information  necessary 
to  reset  the  routine  as  in  (2) . 

Method:    Given  two  numbers,  S  and  B,  considered  as 

integers,  compute  the  sequence  S  •  B  , 

27 
n  =  1,2,...,  2   ,  dropping  all  but  the  low  order 

50    bits  after  each  multiplication.   From 

each  such  30  bit  number,  use  only  the  high 

order  27  bits  to  produce  a  floating  point 

number.   The  constant  B  has  been  set  equal 

to  53^32772^5  (octal)  . 

In  order  to  determine  the  value  of  S  to  be 

used  when  generating  a  random  number,  the 

routine  uses  an  indicator  A,  the  initial 

value  of  which  is  zero: 

I.  If  A  is  zero  and  the  argument  of  the 
function  RAND0M  is  zero,  then  S  =  B. 

II.  If  A  is  zero  and  the  argument  of  the 
function,  say  Z,  is  non-zero,  then 

|Z|   if  Z  is  odd. 
S  = 

|Z|+1   if  Z  is  even. 

ill.   If  A  is  not  equal  to  zero,  then  S  =  A. 

In  all  cases,  after  each  reference  to 

RAND0M,  the  30  bit  number  generated  during 

this  reference  is  stored  in  A.   Normally, 

this  is  then  used  (case  ill)  in  generating 

the  next  random  number. 
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Usage:     There  are  three  entry  points  to  this  routine. 

1)  To  obtain  a  floating  point  random  number 
In  PAP:  In  FORTRAN: 

CLA    ARG  Y  =  RAND0MF(ARG) 

CALL  RAND0M 

The  FAP  program  will  return  the  random  number  In 

the  accumulator;  the  FORTRAN  program  will  store 

the  number  In  the  variable  Y.  ARG  may  be  a  dummy 

variable  or  may  be  used  as  In  (11)  above. 

2)  To  reset  the  value  of  the  Internal  Indicator 

A  to  zero  In  order  not  to  continue  the  current 
sequence  but  to  start  a  new  sequence  use  In 
both  FAP  and  FORTRAN 

CALL  RESETA 
5)  To  save  the  current  value  of  the  Indicator 
A  In  the  variable  Z  for  later  use  (e.g.  to 
continue  the  current  sequence  of  random 
numbers  at  some  later  time) 
In  FAP:  In  FORTRAN: 

CALL  SAVEA  Z  -  SAVEAF(D) 

ST0    Z 

where  D  Is  any  dummy  variable. 
Example:   The  following  sequence  of  FORTRAN  statements 
will  save  the  status  of  the  current  sequence 
of  random  numbers  and  start  a  new  sequence: 
Z  =  SAVEAF(D) 
CALL  RESETA 

Y  =  RAND0MF(some  expression) 

Then  to  return  to  the  Initial  sequence  the 
following  can  be  used: 
CALL  RESETA 

Y  =  RAND0MF(Z) 
Requirements: 

Storage:   26.^  =  32o  locations 
Author:    M.  Goldstein 
Date:      July  1964  (rev.  of  2-26-62  routine) 
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709A  NYU 

UTILITY  /HANDffM  NL>'BEB  GENERATBR  fclTH  i 

N0  STAI 

VJDAHD  ERR0R 

FAP 

709-*  NYO 

UTILITY  /HANOHM  NUVBPfi  GENEBAT0R  XITH  . 

PCC 

C^LNT 

3<3 

LHL 

RANCBZew 

TTL 

RAND0W  NUMBER  GENERATBR  Vi  I  TH  ARBITRAW 

ENTRY 

RAND0M 

ENTRY 

RESETA 

tNTHY 

SAVEA 

FaRTRAN  RANDBM  NLf'BEB  FUNCTIBN  -  FAP  C0DED 


ARBITRARY  START/      RANDOOIO 

.         RAND0020 

RAN00030 

>RBITRARY  START/      RANO0040 

RAND0050 

RAND0060 

RANO0070 

C  STARTING  P0INT       RANDCOeO 

RAND0090 

RANDOIOO 

HANDOl 10 

RANCUM  STH        0  HAN00120 

CAL        A  RAND0130 

TNZ       RANG  RAND01«0 

CAL       C  RANDOISO 

INZ       FIRST  RAND0160 

CAL        E  RAND0170 

FlhST  URA       F  RANDOISO 

SLV»       A  RANC0190 

RANG   LCC       A  RAND0200 

MPY       e  RANDC210 

LLS       5  RAND0220 

PXC       0.0  RAND0230 

LRS       £  RAN0024C 

STC       A  RAND0250 

LLS       32  RAND0260 

^HA       C  RAND0270 

FAC       C  RAND0280 

THA        1.4  RAND0290 

A       0CT       C  RAND0300 

fl       0CT       CC£3'>  3277245  RAND0310 

C       0CT       2C0C0C0CC000  RAND0320 

D       0CT       0  RAND0330 

F       HCT       OCOCOOOCOOOl  RAND034C 

RESfcTA  ST2       A  RAND0350 

TRA        1,4  RAND0360 

SAVHA    CLA        A  RAND0370 

TRA        I ,4  RAND03e0 

ENC  JULY  14.   1964  RAND0390 


-  5^-'  - 


Non-Numeric  Mathematics-Related  Routines 

1.  DIP    Analytic  Differentiation  -  FORTRAN  and 

PAP  Coded. 

2.  P0WR   Power  Series  Package  -  FORTRAN  Coded 
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Identification:     DIF  -  Analytic  Differentiation 

FORTRAN  and  FAP  Coded  -  70 90 

Purpose:   To  analytically  determine  the  n-th  (and  lower) 
derivative  of  a  given  expression. 

Method:    The  expression  is  reduced  to  a  table  of  triples 
which  is  differentiated  row  by  row  and  then 
reassembled  into  a  continuous  string  of 
characters.   See  "Analytic  Differentiation  by 
Computer"  by  Hanson,  J.  W.,  Cavlness,  J.  S., 
and  Joseph,  C.,  Communications  of  the  ACM, 
June  1962,  p.  349,  for  a  complete  discussion 
of  the  method. 

Input :    The  routine  assumes  that  the  expression  to  be 
differentiated  is  found  on  the  input  tape  as 
data  for  the  program.   The  expression  must  be 
written  in  a  simplified,  algebraic  compiler-like 
language  described  below: 

Operand  or  Operation   Symbolic  Representation 
Addition  + 

Subtraction 

Multiplication  * 

Division 
Exponentiation 
Left  Parenthesis 
Right  Parenthesis 
Variable  of 

Differentiation 
Constants 


Transcendental 
Functions 


/ 

P 

c 

) 

Any  alphabetic  character 
other  than  "P" 

Remaining  alphabetic 
characters  and  single 
decimal  digits,  0-9 

Represented  by  "NAME. (a)" 
where  "NAME"  represents 
any  one  of  the  strings 
In  the  following  list 
and  "a"  is  an  expression 
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Function 


Name 


Exponential 

EXP 

Natural  Lo 

garlthm 

L0G 

Sine 

SIN 

Cosine 

C0S 

Tangent 

TAN 

Cotangent 

C0T 

Secant 

SEC 

Cosecant 

CSC 

Arc sine 

ARCSIN 

Arccoslne 

ARCC0S 

Arctangent 

ARC TAN 

Arccotahgent 

ARCC0T 

Arcsecant 

ARCSEC 

Arccosecant 

ARCCSC 

Hyperbolic 

Sine 

SINH 

Hyperbolic 

Cosine 

C0SH 

Hyperbolic 

Tangent 

TANH 

Hyperbolic 

Cotangent 

C01H 

Hyperbolic 

Secant 

SECH 

Hyperbolic 

Cosecant 

CSCH 

Hyperbolic 

Arcslne 

ARSINH 

Hyperbolic 

Arccoslne 

ARC0SH 

Hyperbolic 

Arctangent 

ARTANH 

Hyperbolic 

Arccotangent 

ARC0TH 

Hyperbolic 

Arcsecant 

ARSECH 

Hyperbolic 

Arccosecant 

ARCSCH 

For  example,  the  expression  ax"+bx+sln  ex 

would  be  written  as 

A  ^  XP2  + 

B  *  X  +  SIN.CC 

^*X) 

The  class  of  expressions 

that 

can  be 

differentiated  by  this  program  Is  explicitly 

defined  as 

follows: 
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1)  If  r  is  a  variable  or  a  constant^  then  r 
is  an  expression. 

2)  If  r  is  an  expression,  then  (r),  +r,  and  -r 
are  expressions. 

3)  If  r  and  A  are  expressions,  then  r+A,  r-A, 
r*A  and  r/A  are  expressions. 

h)    If  r  and  A  are  expressions,  then  rPA  is 
an  expression. 

5)  If  r  is  an  expression  and  "NAIffi"  represents 
one  of  the  allowable  transcendental  functions 
given  above,  then  "NAME.(r)"  is  an  expression. 

6)  The  above  are  the  only  allowable  expressions. 
Normal  parenthesis  conventions  are  followed. 

If  parentheses  are  omitted  from  an  expression, 
then  the  precedence  of  the  operators  governs 
the  Interpretation  of  the  expression.   Operators 
of  higher  precedence  are  executed  before  those 
of  lower  precedence.   Operators  on  the  same 
precedence  level  will  be  executed  from  left 
to  right.   The  operators  and  their  precedence 
are  as  follows: 


Operator 

Pr( 

scedence 
7 

P 

6 

-    (unary) 

5 

* 

4 

/ 

4 

-    (binary) 

3 

+   (binary) 

3 

Note:     Square  root  should  be  written  in  terms  of 
exponentiation . 
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Usage:    Entry 

CALL  DIP(ri,I0RD) 
where  N  (IJ  <   9)  is  the  number  of  (consecutive) 
cards  used  to  contain  the  expression  to  be 
differentiated,  and  I0RD  indicates  the  order 
of  the  derivative  desired.   Actually  the  first, 
second  . . .  through  the  I0RD  derivative  will  be 
given.   Column  1  of  the  first  card  must  contain 
the  variable  of  differentiation.   The  expression 
may  be  written  in  free  form  in  columns  2-72  of 
the  first  card  and  columns  1-72  of  any  remain- 
ing cards. 

Output:   The  expression  and  the  desired  derivatives  will 
be  written  on  logical  tape  6  for  printing.   All 
derivatives  up  to  and  including  the  one  specified 
in  the  call  to  the  routine  will  be  printed.   If 
the  storage  reserved  in  the  routine  Is  not 
sufficient  for  a  given  expression,  appropriate 
Instructions  for  modifying  the  routine  will  be 
given  on  the  output  tape.   Mo  algebraic  simplifi- 
cation is  attempted  in  the  present  version. 

Requirements: 

a)  System  Library  Functions  (closed  subroutines) 
The  routine  uses  the  subroutines  necessary  to 
read  an  input  tape  and  to  vnr-lte  an  output  tape. 
These  routines  are  discussed  more  fully  in  the 
last  section  of  this  report. 

b)  Storage 

5049,p|  =  ll671p  locations  plus  the  required 
Author:    Miriam  Shapiro'  subroutines  listed  in  a). 

Date:     February  1964 
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DIF  -  ANALYTIC  CIFFERRKT I  ATI eN  -  FBfiTRAN  II  AND  FAP  CBCEC 

-1    ANALYTIC  DIFFERENT! AT I0N     I  KF   IC    /  M.  ShAPIRe  DIFOOOIO 

suenauiiNt  dif(n,I0rd)  DIFOO020 

>.  IS  Tl-F  NOWeER  0F  CARDS  bSED  F0(i  THE  FUNCTIBN  AND  leRD  IS  Tl-E  0BCEH  OIF0C030 
f.F     THE  DESIRED  DERIVATIVE.    THE  FIRST  CBLLMN  0F  THE  FIRST  CARD  ^LST   OIF00040 

-AVE  Tl-C  VARIABLE  0F  D  I FFERE  N  T  I  A  T  I  0N .    N  ^AY  NeT  BE  GREATER  THEN  9.   DIF00050 

DIMENSI0N  FIJNC(26)  .IFUNC(26)  , JFUNC (26)  ,0FLNC(26)  DIF00060 

CIMENSI0N  FM(JOO,3),K(3OO,3).C(3OC).IC(3OO).0S<648),I0S(6'4e)  OIF00070 

DIMENSI0N  T( ICO) .S(6«8 ) , I S (646)  OIF00080 

DIMENblUN  I»»0PD(e)  DIFOOCJC 

DIMENilBN  FL(50),L(50)  OIFOOIOO 

EOLIVALENCe(FL.L  )  DIFOOllC 

EQUIVALENCE  ( S . IS.0S. I 0S)  DIF00120 

EQUIVALENCE   (Q,  10 )  .  (F2,12)  .(FI  ,1  I  )  ,  (Fg,I9)  DIF00130 

EQUIVALENCE  (FM.y  )  , (F J.IJ)  .(FSS. ISS)  OIF0014C 

EQLIVALENCE(0FUNC ( 1 ) . JFLNC ( l) )  DIF00150 

EULI VALENCE(FLNC(2 ).IL0G).(FL^C(1).IEXF).(FL^C(4),IC0S)  DIF00160 

EQLIVALENCE(FLNC(16).IC«»SH).(FLNC(I5),ISINH),(FUNC(3).ISIN)  DIF00170 
EOLIVALENCE(FLrvlC(7),ISEC),(FLhC{6).ICeT).(FLNC(ie).IC0TH),(FljNC(e)OIFOO18O 
C.ICSC).(FLNC(19),ISECH).(FLNC(20)  .ICSCH)  ,(FONC(5).ITAN),(FLINC(17),OIF00190 

CITANH).(FLNC(1).IFLNC(1)>  OIF00200 

EULIVALENCE(FlEIG.IlEIG).(FI,II).(F24E,I24e)t<F31.I31)  DIF00210 
EauTVALENCE(F24,I24),(F23S.I235).(F46.I46).(F453.I45  3).(Fe3.I63)    DIF00220 

eoUIVALENCE   (FA.  I  A )  .  (F  ISIX.I  ISIX)  DIF00230 

EUHVALENCE(FBLANK,IHLANK).(FTIKES.ITIIi'ES).(FL»'INS.IU»'INS)  OIF00240 

EQUIVALENCE   (FEND.IEND)  DIF00250 

EQUIVALENCE (FPL US.  I  PL  US).  (FLTFAR.ILTPAR)  OIF00  26  0 

ECU  I  VALENCE (FP0INT.IPH INT  ).{FSLASF.  I  SLASH)  D1F0C270 

EQUIVALENCE   (FRTPAR,  IRTPAR)  .  (FMNLS.IMNUS)  .  (FP,  IP)  DIF00280 

EQUIVALENCE   {F60.I60)  DIF00290 

FUNC(  1  )=47e72E  DIF00300 

FONC ( 2 )=274e43                                                     •  DIF00310 

FUNC( 3)=4E3ie2  DIF00320 

FUNC(  4  )=e24e23  OIF00330 

FUNC( 5 )=4£2163  OIF0034C 

FUNC(6)=e34£23  OIFOCISO 

FUNC( 7)=2325e2  OIF00260 

FUNC (e )=23e223  OIF00370 

FUNC(9 )=4E3ie223Sl  OIF003aO 

FUNC(  10)=e24e2323£l  OIF00390 

FUNC (  I  1  )=4S2l6323e 1  OIF00400 

FUNC (  I?  )  =6346232351  DIF00410 

FUNC( 13)=2325622351  DIF00420 

FUNC(  14)=23622323£ J  DIF00430 

FUNC( 15 )=304E3162  DIF00440 

FUNC(  16  )=3Ce24623  DIF00450 

FUNC ( I 7)=30452163  DIF00460 

FUNC ( le )=3C634622  DIF00470 

FUnC(  1<;)=:3C232562  DIF00480 

FUNC(  20=30236223  DIF00490 

FUNC(  21  )  =  304E3162f;  1  OIFOC500 

FUNC(22)=3C624623S1  DIFOC510 

FUNC(23)=3C452163£I  DIF0C520 

FONC( 24 )=3C6346235l  OIF0C530 

FUNC(2£)=3C2325625l  OIF0C54C 

FDNC (26)=3C236223EI  OIF0C550 
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B  0FUNC( 1 )=60eC60256747  DIFO0S6O 

B  0FUNC( 2)=eC6C60434627  OIF0C570 

H  «FUNC( 3)=eC6Ce0623l45  OIF00580 

P  0FUNC( 4 )=eC6C6023a662  DIFO0e9O 

B  0FUNC( £ ) =eC6Ce0632145  OIFOOeOO 

B  0FUNC( 6)=eC6Ce0234663  DIF00610 

0  0FUNC( 7 )=6C6CC0622523  DIF00620 

B  0FUNC( e)=606Ce023e223  OIFOOCSO 

P  0FUNC(<3)=215123623145  OIF0064C 

H  0FUNC( IC )=21£123234ee2  OIF0C650 

D  HFUNCC 1 1 )=215123632145  OIF00660 

R  0FIjNC(  12)=21E  123234663  OIF00670 

B  eFUNC( 13)=215 123622523  OIFOOeBO 

R  0FUKC< 14 )=215 J23236223  DIF00690 

R  KFLNCC 15 )=e060623I4S30  OIF00700 

R  HFUNC(  16  )=606023466230  DIF00710 

8  0FUNC( 17)=6C6063214530  DIF00720 

B  0FUNC( 181=606023466330  OIF00730 

B  0FUNC( 19)=606C62252330  0IF0074C 

R  0FUNC{ 20 1=606023622330  OIF007S0 

B  0FUNC( 21 )=2iei62314530  OIF00760 

B  0FONC( 221=215 123466230  OIF00770 

B  0F(JNC(  23)=2l£163214530  DIF00780 

R  0FUNC( 24 )=2 15 123466330  OIF00790 

H  0FUNC( 251=215162252330  DIFOOeOO 

B  0FUNC( 261=215123622330  DIF00810 

R  Fl=l  OIF00e20 

B  F2=2  DIF00e30 

H  F9=ll  OIF00e4C 

R  F24=24C0C0  DIFOOeSO 

B  F31=3100CCC0C0  DIF00e60 

H  F4e=46CCCC  OIF00e70 

D  F60=60  oiFooeeo 

H  F63=630000  DIF00e90 

R  F235=23500C  OIF00900 

B  F453=453CC0  OIF00910 

B  Flf;iG=100CC0CC0  OIFO092O 

B  FlbIX=1000CCC  DIF0C930 

R  F24e=24000CCCCO  DIF00940 

B  FA=21  OIF009S0 

B  FBLANK=606C60e06060  DIF00960 

B  FfcNC=77  DIF00970 

0  FJ=41  DIF00980 

P.  FLTPAR  =  74  DIF0099C 

B  FM1NUS=40  OIFOICOO 

E  FP=47  OIFOICIO 

B  FPULS=20  DIF01020 

R  FP0INT=33  OIF0103C 

B  FWTPAR=34  OIF0104C 

B  FSLA£^=61  DIF01C50 

B  FSS=e2  OIF01060 

B  FTiyES=54  DIF01070 

B  FUMINS=37  OIFOlOeC 

00,270  11=1.648  D1F01C90 

370  IS(  I  I  ) =0  OIFO 1 100 
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CIF  -  ANALYTIC  C I FFE H E N T  I  A T I e N  -  FafiTRAN  II  AND  FAP  CBCEC 

Kb  =  72»N  DIFOMIO 

RtAC  INPUT  TAPE  5  .OC  .  (  ISC  I  I  )  t  I  1  =  1  .K6)                                      DIF01120 

40  F0R^/AT  (  72A  1  )  .  OIF01130 
IVAR=IS{ 1 )  DIF0114C 
CALL  ShFT3C(IVAR)  DIFOllSO 
K3=C  OIF01160 

C  ELIMINATE  BLANK  COLUMNS  DIF01170 

16=2  OlFOlieO 

DH  12     IAL=2.Ke  DIF0119C 

IF  (IS(IAL)  -  IBLANK)43.t2.43  OIF01200 

'O  IS(  Ifi)  =  IS(  lAL  )  01 FO 12  10 

IB=tB*l  0IF01220 

it2     C0NTINLE  DIF0123C 

K6=I8-1  0IF01240 

WRITE  0UTPLT  TAPE  6 . 34 6 ,  (  I S (  I  I  )  , I  I  =2  .  K6 )                                 DIF01250 

34f  F6)HyAT{//ieh  THE  EXPRESSION  I  S  /  (  6  >  1  1  4  A  1  >  )                               OIF01260 

C  ELIMINATE  PREDEING  OLANKS  IN  EACH  V»2RC  DIF01270 

D0  41  1=2. K6  OIF012aO 

I  I  =  IS(  I  )  OIFOI290 

CALL  SHFT20(II)  0IF01300 

41  IS( I )=I I  OIF01310 
IAL=2  OIF01320 
1=0  0IF01330 
ISC  1  )  =  IEND  OIF0134C 

L( 1 )=IEND  DIF0J350 

1  1B=IB-1  OIF01360 

2  IF(  ISC  IB  )-IPLLS)44 ,45.46  DIF01370 
46  1F(  ISC  IB)- IP(!INT)44.3.48  OIF013eO 
4e  IFC  ISC  IB)- IMINU5)44.S0.51  DIF0139C 
SI  IFC  ISC  IB  )-IP  )44.5?.53  0tF01400 
53  IFC  ISC  IB  )-ITIMES)44.54 . 103  DIF01410 

IC3  IFC  ISC  IB  )-ISLASH)54.S4  .55  OIF01420 

tZ     IFC  ISC  IB )- ILTPAR )44 .56 .57  D1F0143C 

44  LC  lAL  )  =  ISC  10  )  OIF01440 

IFC  IAL-50)4CS.40e.4C6  0IF01450 

4Ce  WRITE  atiTPLT  TAPE  6.407  DIF01460 

4C7  F0kMATC/12CH  INCREASE  SWE  0F  ARRAYS  L  AND  FL.   CHANGE  THe  IF  STATDIF01470 

CEMENT  IMMEDIATELY  F0LL0V»ING  STATEMENT  44  T H  REFLECT  THIS  CHANGE  BYOIFOlAeO 

C/411-  C0MPARING  I AL  AGAINST  THE  NEl»  DIMENSION.  )  DIFOlAgO 

REfLRN  OIF01500 

4C5  1AL=IAL+1  OIF01510 

G0  10  1  DIF01520 

C  Pf.^HR  OIF01S30 

ti     I&AM=6  DIF0154C 

ASSIGN  44  T0  N0ST1  OIF01550 

G0  T0  47  0IF01560 

C  TIMES  AND  SLASH  OIF01S70 

'4  IGAM=4  OIFOlSeO 

ASSIGN  44  T0  N0ST1  DIF01S90 

G0  T0  47  D1F01600 

C  LEFT  PARENTHESIS  DIFOICIO 

5£  IGAM=2  0IF01620 

ASSIGN  ee  T0  N0STI  OIF01630 

GH  T0  47  D1F0164C 

tt     L C  IAL-2 )=L  C  I  AL- I  )  DlFOlfcSO 
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IAL=IAL-I 
G0  T0  I 
C  CHECK  F0R  UNARY  PLUS  AND  MINUS 
£7  IF( IS( IB-1 )-IPLUS)5g.60.5q 
£9  IF(  IS(  IB-1  )-IP0INT )34a.60,340 

348  iF(  is<  IB- 1  )-iy INLS >t i.eo.ei 
ei  IF(  is<  iB-1  )-iTiMes>e2.60.e2 

£2  IF( IS( 19-1 >-ISLASH)63.e0.e3 
e3  IF(  IS(  IQ-1  )-IP»6A.60,6A 
tt      1F(  ISC  IG-l  )-ILTPAR)eS.60.570 
570   IF( 1S( IB-I )-IENO)fc5.60.65 
£b  IU0P=-1 

G0  T0  N0ST2, (63,70) 
£0   IU0P=O 

G0  T0  N0ST2, (ea.7C ) 
C  PLUS 

45  ASSIGN  68  T0  N0ST2 

G0  T0  €7 
68  IF( IU0P)69. 1 , I 
C  BINARY  PLUS  0R  MINUS 
£9  IGAM=3 

ASSIGN  4A  T0  N0ST1 
G0  T0  47 
C  M INUS 

SC  ASSIGN  70  10  NaST2 
G0  T0  67 

70  IF(  IU0P)e9,71,7l 
C  UNARY  MINUS 

71  IS{  IE3)  =  IUMINS 
IGAM=5 

ASSIGN  4  T0  N0STJ 
G0  T0  47 
4  1=1+1 

M(  I.  n=o 

M(  I  ,2)  =  IUMINS 

M( I.3)=L t lAL-l ) 

L(  lAL-I  )=-I 

G0  T0  1 
C  SC0PE 

47  IF(L( I AL-2 )- IPaiNT ) 72,84, 74 
C  BINARY  PLUS  0R  MINUS 

72  ILAC=3 
G0  T0  75 

74  IF(L( IAL-2 )-ILMINS»7e,78.77 
C  RIGHT  PARENTHESIS 

76  ILAG=2 
G0  T0  75 

77  IFILt  IAL-2  )-IP)72,7'5.e0 
C  UNARY  MINUS 

78  ILAC=5 
G0     T0     75 

C    PUVntR 

79  ILAC=e 
G0     T0     75 

eo     IF(L(  IAL-2  )- ISLASH )81 ,81  .82 


oiFoieeo 

OIF01670 
OIF0I680 

DiFoieqc 

OIF01700 
D1F01710 
OIF01720 
DIF0173C 
0IF0174C 
DIF01750 
D1F01760 
DIF01770 
DIF017eC 
DIF0179C 
OIF01800 
DIFOieiO 
OIF01820 
OIF01830 
OIFOieAC 

oiFoieso 
oiFoiaeo 

0IF0ie70 

oiFoieao 

DIF0189C 
OIF01900 
DIFOigiO 
DIF01920 
DIF0193C 
DIF0I94C 
DIFO  1950 
DIF01960 
DIF0197C 
OIF019eO 
OIF01990 
OIF020a0 
OIF02010 
OIF02020 
DIF02030 
OIF0204C 
DIF02050 
DIF02C60 
OIF02070 
DIF020eO 
OIF0209C 
DIF02100 
OIF021 10 
DIF02120 
OIF02130 
OIF0214C 
DIF02150 
DIF02160 
OIF0217C 
DIF02180 
OIF02190 
DIF02200 
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TlVbS  ANC  SLASH  DIF02210 

>-l   ILAC^O  OIF02220 

G^  TZ     75  DIF0223C 

IfNC  fif     LINL  DIF0224C 

ti  ILAC=1  DIF02250 

7S  IF{ ILAG- IGAM )a3.e3.e4  DIF02260 

CD     1=1+1  DIFO2270 

1F(  1-30C  j^Oei'iOeiOOg  DIF02280 

4C9  WRITS  0OTPLT  TAPE  6.110  DIF02290 

410  FlSR^'AT  (  /  1  1  3H  INCREASE  SIZE  BF  ARRAYS  C  AND  IC  AND  0F  FIRST  C  I  ME  NS  1 0 1  F02  300 

C0N  6)F  ARRAYS  M  AND  FK.    CHANGE  THE  IF  STATEMENT  I MME  0  I ATEL  Y/eah  F0OIFO231C 

CLLHwING  STATEMENT  84  TH  REFLECT  THIS  CHANGE  BY  CBMPABING   I  *G A  INSTD I FO 2 320 

C  THE  NE*  DIMENSIKN.)  DIFO2330 

RETURN  DIF0234C 

ACe  M(  I  .  1  )=L(  lAL-n  OIF02350 

M( I ,2)=L( IAL-2)  OIF02360 

MC  I.3)=L(  IAL-3)  DIF02370 

L{IAL-3)=-I  OIF02380 

IAL=IAL-2  DIF023gO 

ca    ra  47  difo2400 

03  CkJ  T0  NUST  I  ,(  44,4  ,  89.58)  OIF02410 

END  0F  LINE  0IF02420 

57  IF(  I  AL-3 )d5. es.fie  DIF0243C 

at     I0AH«=1  OIF024AC 

ASSIGN  eQ  10  Ni^STl  DIF024S0 

G0  T0  47  OIF02460 

4A  OIF0247C 

tt     IF(L<2 )- IVAR )e7.ee .87  DIF02480 

e7  I0S( 1 )=0  DIF02490 

00  T0  26  D1F02500 

ee  ns(  i)  =  i  OIF02510 

G0  T0  26  DIF02S20 

3  IOEL=0  DIF02530 

K=C  DIF02540 

Mu=C  DIF02550 

ICC  IE3=IB-1  DIF02560 

IF(IS1IB)-IPLLS)49.73.90  DIF02S70 

9C  IF  (  1S(  IB  )- IP0INT)4<;.73.91  DIF02580 

91  IF( IS( IB )- IRTPAR )49. 73 .92  DtF02590 

92  IF( ISC IQ )- IMINUS)49.75.93  DIF02600 

93  IF(  IS(  IQ  )-IUMINS)49.73.94  DIF02610 

94  IF(  IS(  U3  )-  IP)4 J.345.95  DIF02e20 

95  IF(  IS(  IH  )-  ITIN'ES>49.73.96  OIF02630 
9fc  IF(  IS(  16  )- ISLASH)49.73.97  DIF0264C 
97  IF(  IS(  tt3  )- ILTPAR)49.71,73  OIF02650 

345  IF( ICEL )73.49. ?J  OIF02e60 

49  IF(K-1  )i!20.221  .220  DIF02670 

220  MU  =  VLi+l  DIF026eO 

IF(ML-6)22?.223.221  DIF02690 

222  K1=IS( IB)  OIF02700 

CALL  CELTA(  ICEL.K I  )  DIF02710 

G0  T0  IOC  DIF02720 

2i3   IF(  IS(  IB  )- lA )221  .224.22I  OIF02730 

2;4  K=l  DIF0274C 

OH  TH   100  OIF02750 
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UIF  -  ANALYTIC  DIFFERENTIAl 


F0RTRAK 


AND  FAF   cacec 


r APE     6.10  1 
.NCTIKN     NAME 


221     WRITE     (?ljTPL 

ici  Fl^R^'AT(/i:3^ 

RETLRN 
73  L(  IAL)  =  IP0INT 
L( IAL+ 1)=ICEL 
IAL= IAL+? 
Ca  T0  2 
START  0F  PART   II 

fc«3  IOeL=I 
3t<;  1=0 

J=ICEL 
5  J  =  J+  1 
1C7  IF(  I-ICEU  )  lOe. 109.  1  IC 

110  WRITE  HIjTPUT  tape  6.111 

111  FURMATf /31(-  PROGRAM  ERRBR. 
G«?  T»  A12 

ICa  1=1+1 

IF(  J-300  )1  1  1  .<.09.«09 

411  IF(V(  I  ,2)- IPLLS)  1  12.e.  112 

112r  IF(M(  I  ,2  )- IMINUS)  I  13.6,  1  13 

113  IF(M(  I  .  2  )- lUMNS)  1  10  .6.  1  1  A 

114  IF(M( I ,2 )- ITIMES) 1 15.7,1 15 

115  IF(C(  I  .2)- ISLASH)  1  16.6. 1 le 
lie  IF(M(  I .2  )-  IP)  117.g, 1  17 

117     IFI^I  I  ,2  )-IPCIINT)  1  le.  10.  1  1( 
lie     WRITE     0tTPLT     TAPE     6.119 
119     F0RMAT(/31I-     PR0GRAM    ERR0R. 
iJLTPLT     TAPE     6.413 


STATENENT  117.) 


412  WRITE  ULir 
4  1  3  FURV AT ( 24f 


JEE  SYSTEMS  PRBGRAMMER.) 


Rf 


0  IFF 

1 20  1AL=M( 1,3) 

CFECK  F0R  RI 

136  IF(IAL)130.127.137 
CHECK  FUR  VARIABLE 

137  IF(  lAL-IVAR)  121 , 122.  121 
CHECK  F0R  C0NSTANT 

lil   IF ( lAL- IPLLS ) 123, 1 24 . 1 25 
IF(IAL-IP01NT)123.124,126 
e  IF(IAL-IJ)124,123,127 
7  IF(  lAL-IP  )  123.  124,  126 
e   IF(  lAL-ITIVES  )  123.  124.  129 
9  IF(  lAL-ISS  )  124.  123.  131 
I   IF(  lAL-ILTPAR  )  123.  124.  124 


12! 


IS      A 


iR I  ABLE 


GH  T0  132 
I  »L  IS  A  CS!NS1 
123     IAL=0 

G0     TH      132 
I AL     IS    RI 
130     I1=-IAL 

I  AL= IQ(  I  I  : 
i;-2  IF(N'U)133, 
i;4   IB=IAL 


OIF02760 
OIF02770 
OIF02780 
DIF02790 
DIF02eOO 
DIFOSeiC 
DIF02e20 
DIF02e30 
0IF0284C 
01F02e50 
DIF02e60 
DIF02e7C 
DIF02e80 
DIF02e90 
OIF02900 
OIF02910 
DtF02920 
DIF02930 
OIF02940 
OIF029SO 
DIF02'S60 
OIF02970 
OIF029aO 
DIF02990 
DIF03000 
01F03010 
DIF0302C 
OIF03030 
OIF03040 
OIF03050 
DIF03060 
DIF03070 
DIF03080 
OIF03090 
DIF03100 
DIF031  10 
DIF03120 
OIF03130 
DIF0314C 
DIF03150 
OIF03160 
OIF03170 
DIF03180 
OIF03190 
DIF03200 
0IF03210 
DIF03220 
DIF03230 
DIF03240 
DIF03250 
OIF03260 
DIF03270 
OIF032eC 
OIF03290 
DIF03300 
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JALVIIC    DIFFERENT  l»TI  «K     -     FtlPTBAN     II     »ND    FAP     CflCEC 


I  33 
lit 
I  .'U 

C    Cbl< 


IK^/Ll-  1  )  13t.  133.  I3S 
lAL^MC  t .  1  ) 
MU  =  -  I 
G0     TH     136 

Cl»     m     NMSIJ,  (  1  39,  149,  161  .  172.?25) 
WRITt:     HOTPLT     TAPE     6,138 

FISNMAT  ( /31H    PRHGRAM    FMR«H.         SIAfKKENT      124.) 
Old     TM     4  12 

IVATIVE     liF     AOOITieN    AND     SOBTRACTieK 
MO  =  0 

Abt>ICN     13<:     TU    Nd£T3 
Ck'     TH     120 

IF  (  I AL  )  14C , 141  ,  14C 
I  f  (  I  U  )  1  4  2  ,  I  4  3  ,  I  4  2 
1U( I )=C 


142 

IFIMl 1 ,2)- IPLLS) 144. 14 

14S 

IF(  IH-1  )32e,329,32a 

3i9 

IU(  I  )■:  I  I 

CM  TM  107 

3ifi 

IU(  I  )^  IH 

GW  \ei     107 

144 

M(  J,2)  =  H.yiNS 

Ct)  Tt«   146 

140 

IF(  IR )  147. 146, 147 

147 

M(  J.2)::M(  I  .2) 

14(j 

1F(  lAL-l  1330.331  ,330 

331 

>»(  J,  1  >»I  1 

GU  T0  232 

33C 

M(  J.  1  )s 1 AL 

332 

IF(  IH-1  1333, 334.333 

334 

M( J.3>»l  I 

Gm  TB  335 

333 

M( J.3)-in 

33S! 

IQI  1  )"-J 

Cl»  TB  5 

i4e 

IF(  IAL-1  )33e.329,336 

3Jt 

IU< 1 )rlAL 

G0  T«1   107 

Ct-K 

IVATIve  BF  ►'OL  r  IML  ICAT  1 

7 

MU  =  0 

ASSIGN  14>;  It     NHSI3 

ta     T«  120 

149 

1F(  lAL  )  152.151.  153 

i!:3 

IF(  lAL-1  )  152.206.  152 

2C« 

IAL-M( I ,3) 

G«  TK  151 

112 

M( J. 1 ).M( 1 .3) 

•'(  J,2I''ITIMES 

M(  J, 3) *  1 AL 

IAL=-J 

J^'J*  I 

1^  I 

|F(  I  O)lt>0,  11.207 

2C7 

IF (  le- 1  )  IbC.  154.  150 

If  A 

Ul»M(  1,1  ) 

OIF0331O 
OIF03320 
DIF03330 
OIF03340 
OIF03350 
DIF03360 
DIF03370 
O|F033e0 
OIF03390 
OIF03400 
OIF034 10 
OIF03420 
OIF03430 
DIF0344C 
DIF03450 
DIF03460 
DIF03470 
OIF03480 
OIF03490 
OIF03500 
OIF03510 
OIF03520 
OIF03530 
DI F03540 
DIF03550 
OIF03560 
r)IF03570 
OIF035eO 
OIF03590 
DIF03600 
OIF03610 
DIF03620 
OlF03t30 
01F0364C 
niF03e50 

DiF03eeo 

DIF03e70 

oiF03eeo 

OIF03e90 
DIF03700 
OIF03710 
PIF03720 
OIF03730 
DIF0374C 
DIF03750 
DIF03760 
DIF03770 
DIF037eO 
DIF03790 
OIF03e00 
OIF03810 
OIF03820 
OIF03e30 
OIF0384C 
0IF03850 
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DIF  -  ANALYTIC  OIFFERENTI ATI BN  -  FBBTRAN  II  AND  FAP  CBCEC 


G0  T0   11 

r'C  J.  1  )=M(  I  .  1  ) 

M( J.2)=ITIMES 

M( J,3)=IB 

IB=-J 

J  =  J+1 

IF(  IAD  155,  ISe.  1S5 

IF(  IB  )  157.  156.  157 

IQ( I )=0 

G0  T0  1C7 


ICi( 


G0  10   107 

IF( IR ) 159, leC. 15S 

IQ(  I  )=IAL 
G0  T0   107 
M(  J.  I  )  =  IAL 
M(  J.2)  =  IPLV,S 
M( J.3)=IH 

IQ( I )=-J 
G0  T0  5 
■EHtNTIATI0N  0F  OIVI! 
MU  =  0 

ASSIGN  lei  T0  N0ST3 
Ge  T0   120 

1F( IB) 162. 163. 162 
MU=  J 
J  =  J*  1 

IF(  IB)  let,  If)  ,2oe 

IF( lO-l ) 164, 165. 164 

IB=f ( 1,1) 

G0  T0  209 

M( J,  1  )=M(  I  ,  1  ) 

M( J.2)=ITIMeS 

M( j,3)=ie 


IF(  IAD  lf.e,  16  7, 

IF(  I AL-1  )  166,  1< 

M(  J,2)  =  HJ^'  INS 

G0  T0   13 

IAL=M( 1,3) 

G0  T0  12 

M( J, 1 )=M( I ,3) 

M(  J.2)  =  ITIN'es 

M( J,3)=IAL 

IAL=-J 

J  =  J+  1 

IF (18)170,169,1 

M{ J,2)=IMINU£ 

M( J,  1  ) 

M(  J,3) 


AL 


M(  J.  1  )=-( J-1  ) 
M( J.2 )=ISLASH 
M( J, 3)=-ML 


oiFoseec 

OIF03870 
DIF03e8C 
DIF03890 
DIF03900 
DIF03S10 
OIF03920 
0IF03930 
DIF03940 
OIF03S50 
DIF03S60 
DIF03S70 
DlF039eC 
DIF03S90 
OIF04C00 
OIF04C10 
DIF0402C 
OIF04C30 
01F04C4C 
OIF04C50 
DIF04060 
OIF04C70 
DIF04CeC 
DIF04C90 
OIF04100 
DIFOAIIO' 
01F04I20 
DIF04130 
OIF04140 
0IF041S0 
DIF04ieO 
OIF04170 
OIF04ieO 
OIF04190 
DIF04200 
DIF04210 
DIF04220 
DIF04230 
OIF0424C 
OIF04250 
DIF04260 
OIF04270 
DIF042eO 
OIF04290 
OIF0430C 
OIF04310 
DIF04320 
DIF04330 
OIF04340 
DIF0435C 
DIF043eO 
DIF04370 
DIF043eO 
DIF04390 
OIF04400 
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IC  OIFFEWEMIATl 


AND  FAP  C0CEC 


K  (MU. 

I  )=M( 

^  (MCf 

2)  =  IP 

W{fh, 

3)?I2 

IQ(  I  ) 

=  -J 

GH  T0 

s 

M(  J.  1 

)  =  1  AL 

C0  T« 

171 

IF  (  I  AL  )  .'04 

1U(  I  ) 

=  0 

Ga  T0  107 


GH 

10 

210 

FFEHtNTI 

AT  IHN 

UF 

P0»ER 

9 

MU  =  I 

D 

ASSIGN 

172 

Ta 

N0ST3 

GH 

T0 

120 

i' 

IK( 

IB)  173.  1 

/o. 

173 

3 

V(  J 

.  1  ) 

=  IL0G 

M(  J 

.2) 

rIPPlI 

NT 

M(  J 

.3) 

=  M(  1  . 

1  ) 

J  =  J 

t  1 

M(  J 

.  1  ) 

=  M(  I  , 

1 ) 

M(  J 

.2) 

=  IP 

M(  J 

,3) 

=  M(  I  . 

3) 

1(  J,  1 )  =-(  J-1 ) 

1(  J.2)  =  I  T  IMES 
U  J.3)=-( J-2 ) 


IF(  ID-  1  )  175.  174,  175 

1  75  M( J,  1  )=-( J-  1  ) 

M( J,2)=ITIMES 

M( J. 3)=in 

MU  =  J 

J  =  J+1 
174   IF( lAL ) 17t . 177. 1 76 
1 7e  IF(  IR  )216.  179,2ie 
179  IF(M(  I  .3)  )2ie.212.214 

2  12  M(  J,2)  =  ILN'INS 

CH  T0  213 
214   IF(M(  I  .3  )-  I  1  )215,2 1  1  .21 

2  11   I0(  I  )  =  1 

ca  Ta  107 

21b  IF(M( I .3 >- 12) J20.319.3: 

3  19  M( J. 3  )  -V (  I  .  1  ) 

Ga  T0  321 
3iC  IF(M( I .3)-I9 )322. 322. 21 
3?2  M( J.3)=M(  I  .3  )-I  1 

Ga  T0  16 
2  le  M( J.2>  =  IMINLS 
2  13  M( J. 1 )=M( I .3) 

M( J, 3>  =  I  I 

J  =  J*I 


OIF04410 
DIF04420 
DtF04430 
DIF0444C 
OIF04450 
DIF044eO 
OIF04470 
OIF04480 
OIF0449C 
OIF04500 
DIF04510 
OIF04520 
OIF04530 
DIF04540 
OIF04550 
DIF04560 
OIF04570 
DIF04580 
DIF04S90 
OIF04600 
OIF04eiO 
OIF04e20 
OIF04e30 
DIF0464C 
DIF04650 
DIFOACeC 
DIF04e70 
DIF04e80 
DIF04690 
OIF04700 
DI F04710 
DIF04720 
DIF04730 
DIF0474C 
D1F04750 
DIF04760 
DIF04770 
DIF047eO 
OIF04790 
DIF04eCO 
OIF04810 
DIF04820 
DIF04830 
DIF04e4C 
OIF04e50 
DIF04e60 
OIF04e70 
DIF04e8C 
OIF0489C 
DI F04900 
DIF04910 
D1F04920 
DIF04930 
0IF0494C 
DIF04950 
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ANALYTIC    DIFFEReNTIATIKN     -     FBfiTRAK     II     AND    FAP     CBCEC 


M(  J,3)  = 
M( J,  1  ): 


176  J=J^ 


G0  T0  ^Z2 

233 

K2  =  0 

225 

IF(  I  I-12't  )23e.237,237 

2it 

IF(  I  I-123E  )23e.239.23q 

236 

K2=K2+1 

G0  Ta  232 

239 

K2=K2+2 

CM  T0  232 

237 

IF(  I  I-  lie  )2'»C.24l  t2'»l 

24C 

IF(  I  1-1453)202. 203. 243 

212 

K2=K2+3 

G0  T0  232 

2'»3 

K2=K2+4 

G0  T0  232 

2'.! 

IF(  I  1-163)244.245.245 

2t,it 

K2=K2+5 

G0  T0  232 

OtF04960 
OIF04g70 


M{J.2)=IP  OIF049eO 

j=j+l  OIF04990 

M( J. 3)=-( J- 1  )  OIF05000 

321  M(  J,  1  )=M(  I  .3)  DIF050I0 

Mt J.2)=ITIMeS  OIF05020 

IFl tAL-I 1 )337, 17,337  OIF05030 

337  IF(  lAL-1  )  1 78. 17.  176  DIF05040 


OIF05050 


M( J.  I  )=-( J-1  )  DIFO£060 

M( J.2)=I TI^ES  OIF05070 

M(J.3)=IAL  DIF0S080 

17  IF(  IP  )  309.  18C.309  DIF05090 

3C9  J=J*1  OIF05100 

M{ J.  1  )=-< J-1  )  OIF051I0 

M(J.2)=IPLLS  DIF05120 

M(J.3)=-MU  OIF05I30 

1  to  IQ(  I  )=-J  OIF0514C 

G0  T0  5  DIF05150 

177  IFC IB) lai. 182. lai  DIF05160 

lei   ia(I)=-(J-l)  OIF05170 

G0  T0  107  DIFOSieO 

162  ia(  I  )  =  0  OIF05190 

G0  T0  107  OIF05200 

10  MU=1  OIF05210 

ASSIGN  22^     T0  N0ST3  DIF05220 

G0  T0  120  DIF05230 

225  IF( IB)?26.227.22e  DIF052A0 
227  IQ( I )=0                                                                          OIF05250 

G0  T0  107  DIF05260 

22t  II=M(I.l)  DIF05270 

IF(  II-IlSiX)228,229,229  DIF052eO 

226  IF{  II-1L0G  )230.231  .230  DIF05290 
231  K2=25  DIF05300 

G0  T0  232  DIF05310 

230  IF(  I  I- lEXP  )233.234 ,233  DIF05320 

234  K2=26  OIF05330 

DIF0534C 
OIF05350 
D1F05360 
DIF05370 
OIF053eO 
DIF05390 
DIF05400 
DIF05410 
0IF05420 
OIF05430 
OIF05440 
OIF05450 
D1F0E460 
0IF05470 
DIF05480 
OIF05490 
OIF05500 
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.(J   PAf-    raceo 


OH    ro   ifi? 
?  f  '«    I  K  I  I     I  1 1  I  r, )  ?  /i  /■ ,  ?  4  7  .  ?  «  / 

H     2 'It     PI  -h  I  •//'/'  ' 

en    in    ►'  f. 
i;/./    IK  I  I- l;^'l^  »;;'»»i..?'*'^  .?A'j 
H   eiu   1^  I  ^t-  i»  1  n  n  /ccQo 

CALL     bhh  t  I  ir  (  I  I  I 

Kj'-e 

(ill     I M     £  )^. 

nii'i    ll■lll-Ml»;f^^o,^'>e.^*e 

M     ?f.(J     p  l=F  I"  //77ii/0C 

CALU   shiPitn  n 

Ki^t  IB 

8J^    CCI     TH     I  ?fil  i^Ctif.eG  J.2Q4  .^SS.ese  .2&7.2*>e.2S<).260.?6l  .26<f.26  J.?<' 
Catb.atJ.ath.ab^.iJCZTX  .2  72t273.274.2  7^.2  76).K2 
C     S  IN 

2t-,<l     M(J,l)  =  |fHb 
2  7«i    Ml  J,  ?  )-  IHH  INI 
Ml  J.   n-MI  I  .  .1) 
I 'J     IK  IN-  I  )27  7.2/(1.2/7 
2/7     IPUH-  I  I  »33U.27M.  11« 
JJM     J-J«  I 

«(J,II^-|J-1) 
Ml  J,2  I  -I  T  If't  S 


2  /('      |1J(  I  )^-  J 
(■Id     I  H    *■, 

f      bINM 

2fl      Ml  J,  I  l^lCKSh 


(•« 


2/'. 


C     CfbH 
2«  /     » 


2  /t 


IN& 


Ml  J.  <■  I 

Ml  J.  1)^1  I 

J  =  J«  I 

MIJ. I )^M( I . Jl 

MlJ.gl  »IP 

Ml  J,  Ji«-i J- n 

(,l»     IH      l<i 

r   crs 

2ffc     MlJ.n-ISIN 

Ml   1.2  )  ^  ll'IrS  INI 
MIJ,  ll-MI  I  .3) 
If     J  a  I  ♦  1 

M  I   J  .  1)  >  0 
Ml  J, 2  I -lOM INS 
Ml  J,   1)«-  I  J-  I  ) 
l.H     I»      I 'J 


Dif o;^io 

D|PO;520 
DIFOISJO 
DIPOSS^O 
DlPOt-SSO 

oiForinfcO 

Dir05^70 

oiFosseo 

DIFO'«'J0 
OlFObtOO 
DIFCSftlO 
01  F05ft20 

oiFo^eao 

OIF0^6«C 
r)IF0?65O 

oiFoseeo 

ssniFoac/o 

DiFoseeo 

niFO^cJO 

DIF0^700 

ni » 05/ 10 

DIf  0')720 
OIF  Ob7 JO 
OIFOS740 
01 F05750 
OIF05760 
DirO?i7  70 

ni I ob7eo 

OIF0^7<J0 

DiFoseoc 

OIF058IO 
DIFCbflPO 

01  ^o^e JO 

OIF05P4C 

OK  n^H50 

Olf  UflHfcO 
01  F0^P70 

niFOSPPC 
OK  o^B>J0 
01 t o^qoo 

Dl P  O'fllO 
OIF0'S'J20 
DIF06<330 

0  I  F  0  5  q  4  C 
DIFO'.'JSO 
OIF05960 
OIF0')<S70 
OIFO^OHO 

01  I  0^<}S)0 

01 r  Of  000 
i>  1 1  o^o  1 0 
01  ro^o^o 
01 ( o^o JO 
on  Of  04C 

O  I  F  06050 
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ANALYTIC     OIFFEHEMI  ATieN 


AND     FAP     C«CEC 


2!f.T     IAL=ISEC 
2C     M( J. 1 )=I AL 

M(  J,2)  =  IPf1INT 

M( J.3 ) =M( I , 3 ) 

J  =  Jtl 

M( J.  1  )=-( J-  I  ) 

M( J,2)=1P 

M( J, J)=l? 

IF(y(  I  . 

2 fc  C     IF     (  M  (  I 
C     CCT 

2ie      IAL=ICSC 
CB     TPI     20 
C      TANH 

2tt)     IAL=ISECH 
Gk)     TH     20 

c  ceiH 

2f:e   IAL=ICSCH 
&0  T0  20 
C  EXP 

2  7t  M( J, 1 )=IFXP 

M(J.2)=IPH1NT 

K(  J,  3)=^'(  1  .  3) 

GH  70  19 

c  stc 

2f;i  IAL=ISEC 
MU=I TAN 
2  1  M(  J,  1  )  =  1 AL 

M(  J.2)  =  IP61  INT 


icn  T  )2eo . I  a, 260 

CHTH)19,16,19 


3)- 


1(1 


J  =  J*  1 

M( J. I )=ML 

M(J,2)=IPHINT 

M(  J.  J)^M(  I  ,3) 

J  =  J+1 

iF(M(i.i)-isec)2ei.2e2,2£ 

2ei  M( J, 1 )=0 

M( J,2)= ILM INS 


M(  . 


3): 


J  =  J»  1 

NIC  J,  3)  =-  (  J-3  ) 

21=3 

M(J,2)  =  ITir'eS 

^'(  J.  I  )=-(  j-1  ) 
Gn    T0    ig 

2^2 

M(  J, 3) -- ( J-2  ) 
G0     TC     263 

c 

CiC 

25? 

IAL=ICSC 
MU=ICHT 
GH     T0     21 

c 

StCH 

2t3 

1AL=ITANH 
MU=ISECH 

OIF06060 
OIF06070 
DIF06080 
DIF06090 

niFoe  100 
DiFoe  1 10 

DIFOe 120 
Dl FOe 130 
DIFOeiAO 
DlFOe 150 
DIFOe 160 
DIFOe 170 

DiFoe  leo 

DIFOe 190 
OIF06200 
OIF0e210 
DIF0e220 
OIF06230 
DIF0e2'»0 
DIF06250 
OIF06260 
OIF06270 
DIF06280 
niF06290 
OIF06300 
DIF06310 
r)IF06320 
DIF06330 
OIF06340 
DIF06350 
OIF06360 
OIF06370 
OIF063eO 
DIF06390 
DIF06<*OC 
OIFOe-*  10 
DIF06A20 
DIF06030 
OIFOe-J'JO 

DiFoef^eo 

DIF0e«6C 
OIF0e470 

DiFoeoao 

DIF06490 
OIF06500 

oiFoesio 

DIF0e=20 
DIF0e530 
DIF0e540 
DIFOeSSO 

oiFoteeo 

DIF0e£70 
OIF06£eO 
Dir06590 
OIF06eOO 
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264 

lAL^ICSCh 

r/u=  ICHTH 

Ctl     TH     2  1 

C     AI.CSIN 

2f  C 

IAL=1 
I&A»'  =  0 

ic 

IPI=C 
M( J. 1)=I1 
M(  J.2)  =  ISLASI- 
^' (  J.3)=I2 
J  =  J+1 

298 

M( J, 1 >=M( I .3) 
M( J.2)=1P 
M(  J,3)  =  I2 

IF  {  I  AL  )2fcA  .285. 

,264 

2es 

y(  J.2)  =  IPLl.S 

2'5fc 

Ml  J,  1  )  =  l  I 

M( J.3)=-( J-1  ) 

297 

J  =  J+  1 

24 

IF< IPI )2ee .287 

.288 

2£8 
2fc9 
202 

3:;9 


M( J.3)=-( J-3) 

J  =  J+1 

IF(IGAy)29C.2fc9.2'30 

IKMU  )  2')1  .  292  .291 

IF( IB- 1 ) 339,340, 339 

M  IJ .  1  )  =  I H 

^'(  J.  3)=-(  J-1  ) 

M(  J,2)  =  ISLA£I- 


)(  I  )^-J 


G0 


34C 

M( J.  1  )  =  I  1 

014     TH     341 

29  1 

Ml  J.  1  ) =0 

M  J.2  )  =  ILMNS 

IFl  IR-  1  1342.343.3. 

342 

y( J.3)=IB 

344 

J  =  J4  1 

MIJ.  1  )^-( J-1  ) 

Ml  J.  3)=-( J-2) 

GU     TH     2S.3 

343 

M( J.3)=I 1 

GH     T0     344 

2iC 

M(  J,  1  ) =M I  I  ,3) 

Ml J.2)=IT!MES 

Ml  J.  3  )  =-  I  J-  1  ) 

J  =  J*  1 

Gt)     TH     289 

2E4 

IFl  IAL-1  1294. 295, 

2  9  5 

Ml J.2)=IMINLS 

Gk)     TH     29t 

oiFoeeic 

DIF0e620 
DIFOe630 
OIFOCCAC 

DiFoeeso 
oiFoeeeo 
oiFoee7o 

DiFoeeec 
DiFoee90 

OIF06700 
DIF06710 
DIF0e720 
DIF06730 
DIF06740 
DIF06750 
OIF0e760 
DIF06770 
DlF067eC 
DIF0e79C 

oiFoeeoo 
DiFoee  ic 

DIF06e20 
DIF06e30 
DIFOtPAC 

DiFoeesc 

OIF06860 

oiFoee70 
DiFoeeec 

OIF06e9C 
Oir0690C 
DIF0691C 
DIF0t920 
DIF0e93C 
01  F0694C 
DIF0e9S0 
DIF0e960 
DIF0e97C 
OIF06980 
0IF0699C 
Dl F07000 
OIF07C  IC 
DIF07020 
OIF07030 
D1F0704C 
OIF0705C 
DIF07060 
OIF07070 
ClF070eC 
DIF07C9C 
OIF07100 
01 F071  IC 
01 F07120 
0  I  F  0  7  1  3  0 
OIF0714C 
DIF07150 
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M( J.2)=IMINb5 
M( J,3)=I 1 
Gt)  T0  297 
i3  IPI= 1 

CH     T0  298 
C  ABCC0S 

2tl  IAL=1 
MU=1 
IGAM=C 
GH  T0  22 
C  Ar-CTAN 

2S<;  IAL  =  0 
MU=0 

iGAy=o 

G0  T0  23 

c  A  r<  c  c  0  T 

2e2  1AL=0 

MU=l 

IGAN'  =  0 

G0  T0  23 
C  ARCSEC 

2=7  IAL=-l 

MU  =  C 

1GAM=1 

G0  T0  22 
C  ARCCSC 

2£e   IAL=-1 

MU=1 

IGAM=1 

G0  T0  22 
C  AhSlNH 

272  IAL=0 

MU  =  0 

iGAr'  =  c 


22 


C   Ar-iCUSH 
273   lAL^ 


IGANixO 
G0  T0  22 

C  ARTANH 

271      IAL=1 
KU  =  0 
IGAM=0 
60     T0     23 

C     At^C0TH 

27^   IAL=1 
MU  =  0 
1GAM=0 
G0  T0  23 

C  AhSeCH 

2t9  IAL=1 
MU=1 
IGAM=1 
G0  r0  22 


DIF07160 
OIF071 70 
OIF07180 
DIF0719C 
DIF07200 
DIF07210 
DIF07220 
DIF07230 
OIF07240 
OIF07250 
OIF07260 
DIF07270 
DIF0728C 
DIF07290 
DIF07300 
OIF0731C 
DIF07320 
0IF0733C 
DIF0734C 
DIF07350 
OIF07360 
DIF07370 
DIF07380 
DIF0739C 
DIF07400 
DIF07410 
DIF07420 
DIF07430 
DIF07440 
DIF07050 
DIF0746C 
OIF07470 
OIF0748C 
DIF07490 
DIF07500 
D1F0751C 
OIF07520 
D1F07530 
DIF0754C 
DIF07SS0 
DIF07560 
DIF07S70 
DIF075eO 
OIF0759C 
DIF07eOO 
DIF07e 10 
DIF07e20 
OIF07630 
OIF07640 
DIF07e50 
OIF07e60 
DIF07e70 
OIF0768C 
DIF07e90 
OIF07700 
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C  APCSCH 

70   IAL=0 
MU=  I 
IOAM=l 
QVt     TH  22 
C  PORT   I  I  I 

1C9  K3=:K3t  1 
I  1=  1 VAW 

CALL  ADOf'LC  I  I  ) 

WRITE  HOTPLT  TAPE  6, 201. K3. II 
201  F0KMAT(2£I-  THE  DEWIVATIVE  f.F     eWDEfi   I 

IF(J-I DEL- 1)163. 183, lei 
U'4  K5  =  J 
J  =  J-  1 
ICNT=1 
10=1 
IAL  =  0 

2t  iF(M( J . 1 ) ) 185 , ifle . lee 

Ite   lF(M(J.2)-lLM^tS)2'39.2ie.2<;9 
2 le  IF ( 10- 1 )32e.325.327 
Ji7  1F{ ICNT- 1 )£ 14.51« .51 3 
tXt*     CALL  LASTC  (  I0S(  IB-1  )  .1  I  ) 

1F(  I  I-IPLtS)£  15.516.?;15 
5ie  CALL  AOOPLf  (  I0S(  IB-1  )  .  IMNtS  ) 

G0  T0  32« 
£lb  1F<  I  I-IMINLS  )^  1  7.5  ie.517 
516  CALL  At;DPLr'(  IHS(  lU- 1  )  ,  IPLLS  ) 

Gk)  ta  32* 
3^5   IF( ICNT- 1)5  17.517.513 
5  17  I I=IMINUE 

ASSIGN  32*  T^  N0ST5 

G0  T0  512 
513  IF(l*l«RD(ICNT-l)-IPLLS)519.£2C.5  19 
5iC   IWHWCl  ICNT-  i  )  =  IMINLlS 

GB  ^9I     32* 
519  IF(IwP).«0(ICNT-I)-IMINL  5)517. 521. 517 
5i 1   I«HHD( ICNT- 1 )=1PLLS 

GM  T0  324 
29  9  IF(M(J.2)-IP0IiJT)i^l7.JOO.217 
3CC  K2=M( J.  1  ) 

DH  30  1   1  I  =  I  .2t 

IF  (K2-IFCKC  (  I  I  )  ) JOl  . 302.301 
31:  I  CUNT  INUt 

Gb)  T0  221 
3Cr   I  I  I  =  JFLNC(  1  I  ) 

IFl  ICNT-l)5eC.5(,0.=6I 

5t  I    nt)   5e;r    i  i  =  iCNT.ft 
5t 2    iwm?D( 11  )=  lec 

CALL  PACK  (  IweWD,  I  I  ) 
lust  I P  )  =  I  I 
Ib=lH»  1 
ICM  =  1 

5  e  c  1 1)  -J  (  1 1  ■ )  =  I  I  I 
lb=iH«  I 
Gn  ^■^    31 


DIF07710 
DIF07720 
OIF0773C 
DIF0774C 
DIF07750 
D1F07760 
OIF07770 
OIF0778C 
0IF0779C 
DIF07e00 
ITH  RESPECT  T0A6.3F  IS)OIF07eiC 
OIF07820 
DIF07e30 
OIF07e4C 
OIF07e50 
DIF07860 
DIF07e70 

DiF07eeo 

OIF07e9C 
DIF07SOO 
DIF07910 
OIF07920 
OIF0793C 
01F0794C 
DIF07q50 
DIF07q60 
OIF07970 
01F07S8C 
DIF07990 
niFOSOOO 
DIFOeOlC 
DIF0eC20 
OIF08030 
DIF0e04C 

oiFoecso 

OIFOOC60 
DIFOfi070 
DIF080eO 
0IF0eC9C 
OIF061CC 

DiFoei  10 

DIF0ai20 
OIF0ei3C 
DIF0ei4C 
DIFOeiSO 
DIFOeifiO 
DIF0ei70 
DIFOe  180 
OIF0ei9C 
DI F082C0 
D1F0M210 
O1F0O220 
OIF08230 
CIF0824C 
DirOH25C 
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217     I  I=V( J.  I  ) 

ASSIGN     31      T0     M4ST5 

G0  T(d  tX2 
il      I1=M(J.2) 

ASSIGN  32A  T0  ^40ST5 

cm  lid  ^12 
3it     IF(M( J. 3 ) ) lee. 187, 167 

le?  I  i=M( J. J ) 

ASSIGN  30  in     N0ST5 


;i2 


iC   IF(  lAL  )2q.2e.29 
I  t5  1 AL=  lAL*  1 

IF(  I  AL-SOIM.AM.Oie 
415  WKITE  HOTPLT  TAPE  6,416 

tilt     FtlnMAT  (  /  1  1  3H  IMCREASE  SIZE  OF  ARRAY  T.    CHANGE  THE   IF  STATEMEf 
CMEDIATELY  F0LL0WING  STATEMENT   185  T0  REFLECT  THIS  CHANGE  nr/t 
CMPARING   lAL  AGAINST   THE  NTl*  DIKENSIgN.) 
G0  T0  ICt 
4  14  L( I AL ) =J 

ASSIGN  les  T0  N0ST4 
G0  T0  nc 
Ic-q  IGAM=II 
K8  =  0 

J=-«( J, 1 ) 
i7  ASSIGN  191   10  N0ST4 
G0  Ta  190 
191  MU=I I 

IF(MU- I  GAM  )  192, 347,  193 
l';2  II=ILTPAR 

ASSIGN  522  T0  M0ST5 
G0  T0  £  12 
5i2  T(IAL)=1.C 

GH  T0  26 
1  i3  T( I AL )=0.0 

GH  T0  26 
347  IF(MU-7)4CC. 192.400 
4CC   IF(MU-4 ) 193,401 , 193 
4r.  I    IF(K8)5eC.  193,58  0 
5^C   IK(M(K8,2)-ISLASH)193.402,193 
4Ci   IF (M( J ,2 )- IT IWES) 193, 192, 193 
C  FIND  PRECEDENCE  0F  M(J,2) 

r:C   IF(M(J.2)-IP0INT)3  14,315,194 
C  KINARY  PLLS  AND  ^' I  NUS 
3  14   11=3 

C,H     T0  N^ST4,  (189.191,200) 
C  P  /  I  N  T 

3  I  t   I  I  =  7 

G0  T0  N0ST4, ( 109, 191 ,200) 
1,4   IKy(J,2)-IMINUS)196,314,197 
C  UNAKY  fINUS 
196   11=^ 

G0     T0     Niisr4,  (  189,  191  ,200) 
19  7     IF(M(J,2)-ITI^'eS)19e,199,199 
C     PK*tR 

1 s  e  11=6 


niFoe260 

OIF0e27C 
OIF082aO 
DIF08290 
DIF0830C 
DIF0e310 
OIFOe320 
DIF0e33C 
DIF0e34C 
OIF0e350 
DIF0e360 
DIF0e370 
OIF083eO 
0  I  F  0  e  3  9  c 

iMDiFoe4CO 
C0oiFoe4 10 

DIF0e420 
DIF0e43C 
OIF0844C 
0IF0e450 
01 F0b460 
OIFOe470 

DiFoe4ec 

DIFOe490 
OIF0850C 
DIFOeSlC 
DIF00520 
OIF08530 
OIFOe540 

DiFoesso 
DiFoeseo 

OIF08570 

oiFoeseo 

DIF0eS9C 

DiFoeecc 
DiFoae 10 

OIF0fie2C 
OIF0e63C 
OIF0e64C 
DIF0B650 

DiFoaeeo 

DIF0e670 
OIF0e680 
Dl F08690 
DIFOe7C0 

oiFoe/ 10 

OIF0e720 
OIFOe730 
DIF0e740 
OIF0e750 
DIF0e760 
OIF0e770 
D.I  F  08  780 
DIF0e79C 

DiFoeeoc 
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G0  TH  NHST/i.  (  189,  191  ,200)  DIF08810 

'•IVES  AND   SLASH  DiFoeeso 

iqg  11=4  DIFOee30 

G0  TH  NHST^i  .  (  iq<3,  191  ,?00)  OIFOCeAC 

lee  iAL=iAL+i  DiFoeeso 

iF( I AL-50) 4  1  ?  .415  ,015  oiFoeeeo 

4  17  L( IAL)=0  OIF0ee70 

ASSIGN   2CC    T0   Nfisit  DiFoeeeo 

f,H  TK  19C  D|F08e90 

2CC  IGAN'^II  OIF089CO 

Ka=j  oiFoeqio 

J  =  -M(J.3)  DIFOe'320 

G0  T0  27  OIF06930 

29     IF( T( lAL ) )203.202.203  OIFOe940 

2C3  1I=IRTPAR  OIF089S0 

ASSIGN  202  T0  M0ST5  OIFOe960 

G0  T0  512  DIF08970 

202  IF(L(  lAL  )  )204,205.204  OIF0898C 

205  IAL=IAL-1  DIF08990 

G0  T0  30  DIF09000 

2C4  J=L( lAU)  0IF09010 

IAL=IAL-1  DIF09020 

C0  T0  31  OIF09030 

ie3  I0S(1)=IC(I)  DIF09040 

2e  D0  550  II=ICNT.6  OIF09050 

550  I«0HD(  I  I  )  =  ieC  O1F09060 

CALL  PACK(  IW0HD,  I  I  )  OIF09070 

I0S(  10  )=  1  I  01 F09080 

WHITt  0ljTPtT  TAPE  6,404.  (  10S(  I  I  )  .11  =  1  .18)  DIF09090 

4C4  FaRMAT ( exl9Ae )  DIF09100 

IF(K3- IHHD )35e,35. 356  DIF09110 

3fe  IDEL=K5-1  OIF09120 

J-K5  OIF09130 

G0  T0  107  OIF0914C 

35  HETLRN  OIF09150 

512  II«MRD(  ICNT  1=1  I  OIF09ieO 

IF{ ICNT-6)50e.bO7,507  OIF09170 

bC7  CALL  PACK!  IK0HO.  I  I  )  OIF09180 

I0S(  IR  )  =  I  1  DIF09190 

IQ=IB+1  DIF09200 

ICNT=0  DIF09210 

D1F09220 
)  DIF09230 

OIF0924C 

DIF09250 

OIF09260 

BF   10  OIF09270 

OIF092eO 
DIF09290 
DIF09300 
DIF09310 
DIF09320 
DIF09330 
OIF09340 
DIF09350 
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see 

ICNT=ICr 

JT+l 

5  10 

G6J  T0  N0STS.  (324.31 

,30.20- 

END 

NH   STAf 

MUAHO  ERRBH 

F  AP 

ANALYTIC  DIFFERENT 

lAT I0N 

CHLNT 

10 

LRL 

C1F2.N 

ENTRY 

enosu 

irJCEH 

CLA» 

1  .4 

ARS 

12 

ANA 

VASK 

ST0» 

1  .4 

TRA 

2.4 

DIF  -  ANALYTIC  D I FFE REN T I  A T I BN  -  FBCTRAK  II  AND  FAP  CeCEC 

MASK     0CT       770CC0OC  DIF09360 

END  OIF09370 

•  N0  STANDARD  ERR0R  DIF09380 

•  FAP  DIF09390 
»        ANALYTIC  DIFFERENTI AT I0N     3  0F  10  DIF09A00 

CaUNT     IC  DIF09410 

LHL       CIF3.N  DIF0S420 

tNTRY     ShFT30  DIF0g430 

SHFr30  CAL»      1.1  DIF09440 

AKS       JC  DIF09450 

STn«    1.4  oiFog^eo 

TRA       Z,H  DIF0gA70 

END  DIF09480 

•  NH  STANDARD  eRR0R  DIF09A90 

•  FAP  D1F09E00 

•  ANALYTIC  CIFFEREKTIAT I0N  A  eF  IC  DIF09510 
CyuNT  IC  DIF09520 
LBL  DIFA.N  DIF09530 
ENTRY     DELTA  OIF09S40 

DELTA  CLA*      1,4  DIF09S50 

ALS       fc  SHIFT  DELTA  OIF09560 

0RA»      2.4  ADC  S-BETA  DIF09570 

bT0«    1.4  oiFogseo 

THA       2.4  DIF09590 

END  oiFogeoo 

»  NH     STANDARD     ERR0R  OIF09610 

•  FAP  DiFogeso 

•  ArjALYTIC  C  IFFERENTI  AT  I0N  5  KF  IC  DIFOge30 
C0UrjT  5  DIF0g640 
LHL                   CIF5.N  DIFOgeSO 

trjTRY        SFFT12  DiFogeeo 

SHFT12  CLA»      1.4  OIF09e70 

AR3     12  oiFogeeo 

bT0»      1 . 4  DI F0g690 

TWA       2,4  OIFOg700 

END  DlF0g710 

•  N0  STANDARD  ERRZR  DIF0g72C 

•  FAP  DIF09730 

•  ANALYTIC  C I FFERENT I  AT  I 0N  6  BF  10  DIF0g74C 
C0UNT  5  DIF0g750 
LDL  DIFe.N  DIFOg760 
ENTRY     SHFT6  DIF09770 

SHIFT6  CLA*      1.4  DIF09780 

ARS     e  DiFog7go 

sTn«    1 . 4  DI Fogeoc 

TRA       2.4  DIF09810 

END  DIF0ge20 

•  N0  STANDARD  ERR0R  DIF09830 

•  FAP  DIF0ge40 

•  ANALYTIC  DIFFERENTI AT  I 0N     7  0F   10  DIFOgeSO 

C0UNT   6  DiFogeeo 

LEiL  DIF7.N  DIF09e70 

ENTRY  ACDEL  OIF09e80 

ADDFL  CAL*    1.4  oiFogego 

0RA       BLANKS  DIF09900 
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TRA        d,t 

RLANKS 

0cr     t06C 

ENC 

« 

NH  STANDARD  1 

« 

FAP 

« 

ANALYTIC   CIFI 

C0LNT     5C 

LBL       DIFE 

ENTRY     PACK 

ALS 

30 

SLW 

CLA 

SUB 

ST0 

CLA* 

ALS 

STB 

T2tl 

CLA 

bUE 

ST0 

CLA» 

ALS 

ST0 

TZ  +  2 

CLA 

SUG 

3TH 

CLA. 

ALS 

STB 

T2  +  3 

CLA 

sue 

iT0 

CLA« 

ALS 

ST0 

12*A 

CLA 

sue 

STB 

CLA. 

ACC 

T2  +  4 

ACD 

T2*3 

AOO 

T242 

ACC 

T2+1 

ACL 

SLU* 

2>A 

TRA 

3  •  4 

DEC 

HCT 

CO. C. 0.0 

END 

N  K   S  T  A  1 

vJCARD  ERRefl 

01F099IO 
OtF09920 
DIF0993C 
DIF0S94C 

DiFoggso 

DIF09960 
DIF09970 
DIF099eO 
OIFC9990 
OIFIOOOO 
DIFIOOIO 
DIF10020 
OIF1C030 
OIF1004C 
OIF10050 
DIF10060 
OIF10070 

oiFiooeo 

OIF1C090 
OIFIOIOO 
OIFlOllO 
OIF10120 
OIF10130 
DIF1014C 
OIF10150 
DIFI0160 
DIF10170 
DIF10180 
OIF10190 
OIF10200 
OIF10210 
DIFI0220 
DIF 10230 
OIF1024C 
OIF10250 
DIF10260 
DIF10270 
OIFJ02eO 
OIFt0290 
DIF10300 
OIF10310 
DIF10320 
OIF10330 
DIF1034C 
DIF10350 
DI F 10360 
OIF10370 
DIFlOSeO 
DIF 10390 
OIF10400 
OIFI0410 
OIF1C420 
OIF10430 
DIF10440 
DIF10450 
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DIF10460 
9  0F   IC  DIF10470 

OIF104eO 
DIFI0490 
OIFIOSOO 
DIFIOSIO 
DIF10520 
DIFIC530 
OIF10S40 
DIF10550 
DIF1C560 
OIF10570 
DIF10580 

10  eF  ic  DiFiosgo 

OIF10600 
DIFlOeiO 
DIF10620 
DIF10630 
DIF1064C 
DIF10650 

DiFioeeo 

DIF10670 

oiFioeeo 

DIF10690 


• 

FAP 

» 

ANALYTIC  CIFFERENTIATIBN 

C0UNT 

1  0 

LBL 

D IF9,N 

KNTRY 

LASTC 

LASTC 

CLA» 

1  .4 

ANA 

MSK 

ST0« 

2.4 

TRA 

3.4 

NISK 

0CT 

ENC 

77 

« 

NH   STAl 

NDARD  ERR0R 

« 

FAP 

• 

ANALYT 

IC  DIFFERENT IATI0N 

C0UNT 

IC 

LBL 

DIFIO.N 

ENTRY 

ACOPLM 

AOOPLM 

CAL» 

1  .4 

ANA 

MSK 

0RA» 

2.4 

SL*« 

1  .4 

TRA 

3.4 

M3K 

0CT 

END 

777777777700 
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Identification:     P0WR  -  Power  Series  Package 

7  FORTRAN  II  Functions,  and 
5  FORTRAN  II  Subroutines  -  709O 
Purpose:  A)  To  evaluate  or  to  form  the  product  or  quotient 
of  two  power  series  in  two  variables  or  to 
differentiate  or  Integrate  such  a  power  series 
or  to  find  a  point  along  a  level  line  defined 
by  the  power  series. 
B)  To  find  the  resulting  series  by  taking  the 
sine,  cosine,  logarithm,  exponential,  or 
power  of  a  power  series  in  one  variable. 
Description: Given  the  coefficients  of  a  series  the 

routines  return  the  coefficients  of  the  series 
resulting  from  the  above  operations. 
The  subroutine  finds  a  point  along  a  curve 
represented  by  P(X,Y)  =  constant  where  the 
coefficients  of  the  series,  F,  Sp/Sx  and 
^P/^y  are  given  along  •With  another  point  on 
the  curve. 

The  evaluation  routine  sums  the  series  by 
nesting.   The  coefficients  and  the  point  of 
evaluation  must  be  given. 

Each  function  is  complete  in  itself  and  may 
be  used  without  the  others  if  so  desired. 
The  sine  and  cosine  routines  are  combined. 
The  subroutine  for  the  level  lines  uses  the 
evaluation  routine. 
Restriction:  Each  routine  has  been  compiled  from  a  source 
deck  with  a  DIMENSK?'^  statement  for  the  matrices 
or  vectors  Involved  of  size  25  x  25  and  25 
respectively.   There  are  no  restrictions  within 
the  routines  limiting  the  dimension  size; 
therefore,  if  larger  (or  smaller)  matrices  are 
desired  by  the  user  the  source  decks  of  the 


571  - 


Use: 


functions  and  subroutines  should  be  recompiled, 
and  the  DII-ENSIQ^  statements  changed  accordingly. 
In  any  case,  the  order  of  the  matrix  formed  may 
always  be  ^  1  ^  dimension  size. 

For  each  routine  described  on  the  following  pages 
P,Q   are  the  coefficients  of  the  power  series 
In  2  variables  stored  as  square  matrices 
In  the  manner  defined  In  the  function 


PEVAL,  l.e 


Ij 


Is  the  coefficient  of 


X,Y 

DIM 


K 
I, J 


are  the  2  variables. 

Is  the  DIMENSION  size  (DIM, DIM)  of  P 

and/or  Q  and/or  R.   (As  complied  DIM  In 

all  these  functions  Is  25.   See 

Restrictions . ) 

Is  the  order  of  the  matrix.   1  _f  K  j<  DIM. 

are  the  subscripts  of  the  resultant 

coefficient  desired. 


1  <  [jj  ^  K  _<  DIM. 
VALUE  Is  the  name  of  a  variable  which  will 

contain  the  value  of  the  function  upon 
return.   "VALUE"  will  usually  be  of  the 
form  R(I,J)  within  a  D^  loop  such  as 
D0  1   I  =  1,K 
D0  1   J  -  1,K 
1   R(I,J)  =  S0ME  PUNCTI0N  "(P,I,J,K)" 


I.  PEVAL.  Evaluates  a  polynomial  In  2  variables. 

K  K-1+1       ,  , 
P(X,Y)   =  XI  2Z   P-  •  X    Y^-^ 

where  the  degree  of  P  ^  K-1;  I.e.  (1-1 ) +( j-1) <K-1 
To  Use:   Write  the  FORTRAN  statement: 
VALUE  =  PEVAL(P,X,Y,K) . 

II.  PMPY.  Multiplies  P' 

If  P-Q  =  R  then  R- 


I   J 
^I,J  "  |i^  ^  ^ij  ^I-l+l,J-j+l 
To  Use:  Write  the  FORTRAN  statement: 


VALUE  =  PMPY(P,Q,I,J) 
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III.  PDIV. Divides  P/Q 


If 

P/Q  = 

R  then 

I-l 

.T 

^I,J^ 

J-1 

,J 

.J 

-^ 
«i.j- 

«ij 

i«i. 

-i+l,J 

-J+1 

To  US( 

s:      The  algorithm 

for  the 

division 

of  power 

^i,m 

0  <  ^  <  I-l;    m  =  1 

and 

Rl,m 

m  =  1 

Write 

the  FORTRAN  statement 

series  requires  the  results  of  previous  coefficients 
Therefore,  this  function  should  be  used  to  compute 
the  coefficients  in  order.   For  R,  ^  the  function 
computes  P,  -i /Q-i  -i  •   To  compute  R-j-  j   it  is 
necessary  to  have  computed 

2,  .  .  .,J 

1,2,  . . .,J-1. 

t: 

VALUE  =  PDIV(P,Q,I,J,R) 
where 
R     is  a  square  matrix  (of  DIMENSI^^N  DIM, DIM) 

where  the  previous  necessary  coefficients 

may  be  found  by  the  function. 
Note:  Answer  is  both  in  VALUE  and  R(I,J). 

IV.  PDERX. Finds  partial  derivative  of  P  with  respect  to  X- 

If 

1^^  =  R   then  R^  t  =  I  '  ^r^i     t 
dx  I, J       I+1,J 

To  Use:   Write  the  FORTRAN  statement: 

VALUE  =  PDERX(P,I,J) 

Note:   I  must  be  <  DIM-1. 

V.  PDERY .  Finds  partial  derivative  of  P  with  respect  to  Y. 

If 

^fP=  R  then  Rj^j  =  J  '  Pi,j+i 
To  Use:   Write  the  FORTRAN  statement: 

VALUE  =  PDERY(P,I,J) 
Note:   J  must  be  <  DIM-1. 
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VI.  PINTX. Integrate  P  with  respect  to  X.   If 
pX 
I   P(X,Y)  dx  =  R  then  Rj  j  =  Pj_i  jA"! 

To  Use:   Write  the  FORTRAN  statement: 

VALUE  =  PINTX (P, I, J) 

VII .PINTY.  Integrate  P  with  respect  to  Y.   If 
Y 

j?{X,Y)    dy  =  R   then  Rj  j  =  Pj  j-l/'^"^ 

"o 

To  Use:   Write  the  FORTRAN  statement: 
VALUE  =  PINTY(P,I,J) 
VIH-  P0IN.  To  find  by  iteration  a  point  (XI, Yl)  along 
the  curve  P(X,Y)  =  constant  a  distance  RH0 
from  another  point  (XO,YO)  on  the  curve. 
To  Use:   Write  the  FORTRAN  statement: 

CALL  P0IN(P,XO,YO,K,RH0,III,PX,PY, 
XLIM,LL,NARG) 
where 

K+1    is  the  degree  of  P 
III    is  a  test  index  which  equals  999  if 

convergence  is  not  attained 
PX,PY  are  the  matrix  of  coefficients  of 

SP/5X  and  SP/dY  respectively 
XLIM   is  the  convergence  criterion 
LL    is  half  the  maximum,  allowed  iterations 
XO,YO  are  the  coordinates  of  the  starting 

point;  the  new  coordinates  are  stored 

in  XO,YO. 
NARG   should  be  set  to  zero  the  first  time 

the  routine  is  called  for  a  particular 

curve.   The  routine  resets  NARG  to  1; 

this  value  should  be  retained  until  a 

new  curve  is  used. 
IX.  PEXP.  Find  the  series  of  exp  [P] 


574 


If 

Q  =  exp{P} 


)2  -   P2Q1 


PpO,    T  K-1 

(K  =  2,,..) 
To  Use:   Write  the  FORTRAN  statement: 

CALL  PEXP(P,Q,N) 
N  =  DIM(P)  =  DIM(Q) 
X.  PL0G.   Find  the  series  of  log  (P),   If 
Q  -  log  {P] 

Q^  =  log  (P^) 
Q2  -   Pg/Pi 

QK4-1   -    f^K+l    -  l|^    ^^-^^    Vi+1   ^4-1^/^1 

(K   =    2,5,...) 
To  Use:      Write   the   FORTRAN   statement: 
CALL  PL0G(P,Q,N) 


N     =  DIM(P)  =  DIM(Q) 
^ie 


XI.  PPWR.  Find  the  series  for  P"^.   If  Q  =  P^ 


'1  =  p'l 

I2  =  X  QiPg/^l 


t^  Qg  Pg  +  X  Qi  Pjl/Pi 


^^    t^^-ll-^K+l-i^+l^/Pi 
(K   =    3,^,...) 
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To  Use:   Write  the  FORTRAN  statement: 

CALL  PPWR(P,Q,X,N) 
N  =  DIMCP)  =  DIM(Q) 
XII.  PTRIG .   Find  the  series  for  sin(P),  cos(P).   If 

Q  =  sin(P)   and  R  =  cos(P) 


Q^  =  sin(P^)  ,    R^  =  cos(P^: 
Q2  =  R^Pg     .    ^2  =  "  ^1^2 


^K+l  =  Vk+1  +i^  (K-DR^^l  Pj,_,^, 

(K  =  2,3,...) 

To  Use:   Write  the  FORTRAN  statement: 

CALL   PmiG(P,Q,R,N) 
N  =  DIM(P)  =  DIM(Q)  =  DIM(R). 
Requirements: 

a)  Non-System  Subroutines 
P0IN  uses  PEVAL 

b)  System  Library  Functions  (closed  subroutines) 
PEXP  uses  EXP 

PL0G  uses  L0G 
P0IN  uses  SORT 
PTRIG  uses  SIN,  C0S 

c)  System  Built-in  Functions  (open  subroutines) 
PDERX  uses  FL0AT 

PDERY  uses  FL0AT 
PINTX  uses  FL0AT 
PINTY  uses  FL0AT 
P0IN  uses  ABS 
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d)  Storage 

PDERX   55;lo  "  ^^8  locations 

PDERY   57]_o  =  7I3  locations 

PDIV  384^Q  =  600g  locations 

PEVAL   69, Q  =  105o  locations 

PEXP   133io  =  ^'^^8  locations  plus  the  required 

subroutines  listed  in  b) 
PINTX  69^Q   =  105g  locations 
PINTY  l87]_o  "  2733  locations 
PL0G   l^lno  "  ^"^^8  locations  plus  the  required 

subroutines  listed  in  b) 
PMPY   11^;lO  "  -^^^8  locations 
P0IN  ^19-10  ^   ^^^8  locations  plus  the  required 

subroutines  listed  in  a)  and  b) 
PPWR  196-LQ  =  304g  locations 
PTRIG   IS^HQ  =  270g  locations  plus  the  required 

subroutines  listed  in  b) 
Author:    J.  Leavitt  and  F.  Ragusa 
Date:      July  I963 
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»        LIST8  P0WROO1O 

CPEVAL      P0WER  SERIES  FUNCTI0N  T0  EVALLATE  A  P0LYN0KIAL  IN  2  V AR I ABLES .P0 WR0020 

CI           P  IS  A  SQUARE  25.25  MATRIX  0F  eRDER  LESS  THAN  0R  =25  X  25  P0WROO3O 

C2           AS  KRITTEN.     DIMENSIBN  MAY  BE  CHANGED  BY  CHANGING  CiyENSIBN   P0WROO4O 

C3           STATEMENT   IN  THIS  S0URCE  CECK.  P0WROO5O 

C4           WRITTEN  AT  NYU.AEC  C0MPUTING  CENTER  BY  J.LEAVITT.  PREPARED      P0WRCO6O 

C5           BY  F.RAGLSA.  P0WROO7O 

C6  DEGREE   IN  X  LESS  THAN  0R  =K-I.  SAME  F0R  Y.  K  IS  0RDEH  0F  M ATRXP0 WR0080 

C7  P0WROO9O 

FUNCTI0N  PeVAL(P.X.Y.K)  P0WRO1OO 

D1MENSI0N  S( 25 ).P(25.25)  P0WROI1O 

C            K  =  REAL  SIZE  0F  P.  P0lil(ROI2O 

K2=K-1  P0WROI3O 

00  1  N=1.K2  P0WROt4O 

K3=K+1-N  P0WROI5O 

s(N)=P(K2.N)  pawHOieo 

00  1   1=2. K3  P0»IROI7O 

K'>=K3+i~i  pawROiao 

S(N)=S(N )»X+P(K4,N)  P0WRO19O 

1  C0NTINLE  P0WRO2OO 
PEVAL  =P(1.K)  P0WRO21O 

C  P0WRO22O 

D0  2  1=1. K2  PawR0230 

K5  =  K-I  P0Vi(RO24O 

PEVAL=PEVAL»Y  +  S(K5  )  P01ii(RO25O 

2  C0NTINLE  P0WRO26O 
RETURN  P0WRO27O 

END  P0Vi(RO2eO 

•  LIST8  P0WRO29O 
CPINTX  P0WER  SERIES  FUNCTI0N  T0  INTEGRATE  P  »ITH  RESPECT  T0  X.  P0ttRO3OO 
CI  P  IS  A  SQUARE  25.25  MATRIX  0F  0RDER  LESS  THAN  0R  =25  X  25  P0WRO31O 
C2  AS  WRITTEN.  OIMENSI0N  MAY  BE  CHANGED  BY  CHANGING  DIMENSI0N  P0WRO32O 
C3  STATEMENT  IN  THIS  S0URCE  CECK.  P0WRO33O 
C4  WRITTEN  AT  NYU.AEC  C0MPUTING  CENTER  BY  J.LEAVITT.  PREPARED  P0WRO34O 
C5  BY  F.RAGLSA.  P0WRO35O 
C6  P0WRO36O 

FUNCTI0N  PINTXIP.I.J)  P0WRO37O 

DIMENSI0N  P(25,2=)  P0WRO38O 

IF(  I-l  )  I  .  1  .2  P0WRO39O 

1  PINTX=0.0  P0WRO4OO 

G0  T0  5  P0WRO41O 
C7A          STATEMENT  N0.S  2  THRUA  SET  ASIDE  IN  CASE  0THER  TESTS  WANTED.   P0WRO42O 

2  C0NTINLE  P0WRO43O 
PINTX=P(I-I,J)/FL0ATF(I-1)  P0WRO44O 

5       RETURN  P0WRO45O 

END  P0WRO46O 

•  LISTS  P0WRO47O 
CPINTY  P0WER  SERIES  FUNCTI0N  T0  INTEGRATE  P  WITH  RESPECT  T0  Y.  P0WRO48O 
CI  P  IS  A  SQUARE  25,25  MATRIX  0F  BRDER  LESS  THAN  0R  =25  X  25  P0WRO49O 
C2  AS  WRITTEN.  DIMENSION  MAY  BE  CHANGED  BY  CHANGING  OIMENSI0N  P0WHO5OO 
C3  STATEMENT  IN  THIS  S0URCE  CECK.  P0WRO51O 
C4  WRITTEN  AT  NYU.AEC  C0MFLTING  CENTER  BY  J.LEAVITT.  PREPARED  P0WRO52O 
C5           BY  F.RACUSA.  P0WRO53O 


P0WRO5' 
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FUNCTION  1 

JIN 

TY 

(P.  I 

CIVENSIHN 

P( 

25 

.25  ) 

1F(  J- 

I  )1 

.  1 

,2 

PINTY=0.0 

G0  T« 

5 

=  0V>H  -  Pa*ER  SERIES  PACKAGE  -  FORTRAN  II  CeOEO 

P0WRO5SO 
P0NH<O56O 
P0WRO57O 
P0WRO5aO 
P0V.RO59O 

2       CUNTINLC  P0WRO6OO 

P1NTY  =  P(  I  .  J-  1  )  /FL0ATF(  J-1  )  P0»RO61O 

5       RETURN  P0WRO62O 

tNC  P0wROe3O 

•  L I S  T8  P0WHO64O 
CPKPY  P0«eR  SEDItS  FLNCTI0N  T0  ^LLTIPLY  P  TIMES  C.  P0«RO65O 
CI  P  ANC  C  ARE  SQLARC  MATRICES  HF  gRCER  LESS  THAN  0R=25X25  AS  P0WRO66O 
C2  AS  WRITTEN.  DIMENSieN  ►'AY  BE  CHANGED  PY  CHANGING  CIMENSieN  P0WRO67O 
C3  STATEMENT  IN  THIS  S0URCE  CECK.  P0WMO6eO 
CA  *h)ITTEN  AT  NYU.AEC  COMPUTING  CENTER  RY  J.LEAVITT.  PREPARED  P0WHO69O 
C5  HY  F.RAGLSA.  P0I*RO7OO 
C6  P0«RO71O 

FUNCTI3N  PVPYC P.G, I . J )  P0*RO72O 

Dir/ENbI0N     Pt  25.25  )  .0(25.25  )  P0WHO73O 

C  P0WHO74C 

SUM  =  0.0  P0»(RO75O 

D0  1  K= I . I  P0*RO76O 

00  1  L  =  l  . J  P0 "RO  770 

M=I-K+1  P0WHO78O 

N=J-L*1  P0WRO79O 

1   SUM  =P(K.L  )»C(  M.N)+SLM  P0WRO8OO 

PMPY=SLM  P0WHO81O 

RETURN  P0WRO82O 

END  P0«rROe3O 

«        LISTd  P0*ROeAO 

CPObHX      P0WER  SERIES  FUNCT10N  TB  FIND  PARTIAL  DERIV.  XITH  RESPECT  T0  XP0wRO85O 

CI           P  IS  A  SQUARE  25.25  MATRIX  0F  eRDER  LEbS  THAN  0R  =25  X  25  P0i«ROe6O 

C2             AS  WRITTEN.     CIMENSIeN  MAY  BE  CHANGED  PY   CHANGING  DIKENSIBN  P0WROe7O 

C3           STATEMENT   IN  THIS  S0URCE  CECK.  P0*ROe8O 

C4           WRITTEN  AT  NYU.AEC  C0MPUTING  CENTER  EY  J.LEAVITT.  PREPARED  P0wHOfl9O 

CS           6Y  F.RAGLSA.  M0wRO'3OO 

C6  P0WRO91O 

FUNCTI0N  PDERXCP.I.J)  P0WRO92O 

DIMENSION  P{25.25)  PawW0930 

C  P0WHO9AC 

PDCHX=FL0ATF(I)»P(Itl.J)  P0WRO95O 

HbTUHN  P0WRO96O 

END  P0WRO97O 

•  LISTe  P0wRO9eO 
CPDEHY  P0WER  SERIES  FUNCTI0N  10  FIND  PARTIAL  DERIV.  WITH  RESPECT  T0  YP0WRO99O 
CI  P  IS  A  SQUARE  25.25  MATRIX  0F  KROER  LESS  THAN  0R  =25  X  25  P0WRIOOO 
C2  AS  WRITTEN.  DIMENSI0N  MAY  RE  CHANGED  PY  CHANGING  CIMENSIBN  P0WRIO1O 
C3  STATEMENT  IN  THIS  S0URCfc  CECK.  P0WR1C2O 
C4  WRITTEN  AT  NYU.AEC  C0MPUTING  CENTER  DY  J.LEAVITT.  PBEPAREC  P0WR1C3O 
C5  BY  F.kACUSA.  P0WR1O4O 
C6  PawklCSO 

FUNCTIKN  PCERY(P.I.J)  P0WWIC6O 

DIMENSI0N  P(25.25)  P0WR1O7O 

C  P0WR1O8O 

POESY=FL0ATF(J)«P(I.J*1)  PawRIC90 
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RETURN  P0WRHOO 

EMD  P0WR111O 

•       LIST8  P0WR112O 

CPDIV       P0WER  SERIES  FUNCT10N  TB  CIVICE  P/C.  P0WR113O 

CI  P  A^JD  Q  ARE  SQUARE  MATRICES  0F  0RDEH  LESS  THAN  0R  =  25X25  AS  P0WH114C 

C2  AS  WRITTEN.     DIMENSI0N  MAY  BE  CHANGED  BY  CHANGING  C I  MENS  I 0N   P0WR115O 

C3  STATEMENT   IN  THIS  S0URCE  CECK.  P0WR116O 

C4  WRITTEN  AT  NYU.AEC  C0MPLTING  CENTER  BY  J.LEAVITT.  PREPARED  P0WR117O 

C5  BY  F.RAGLSA,  P0WR118C 

C6  P0WRliqO 

FUNCTI0N  PDI V(P.Q. I , J,R)  P0WR12OO 

DIMENSI0N  P( 25 .25 ) .0(25.25) .R(25. 25)  P0WR121O 

C  P0WR122O 

IF  DIVIDE  CHECK  30.30  P0VirRl23O 

30     SUMA=0.0  P0wrtl24O 

SUMB=0.0  P0WR125O 

IF( I-l ) 1. I .2  P0WR126O 

1  IF(J-1)3.3,4  P0WR127O 

2  IF(J-1)5.5.6  P0WR128O 

3  PDIV=P(  1 . I  )/C(  1, I )  P0WR129C 

G0  T0  e  P0WR13OO 

C  P0WR131O 

1     J2=J-1  P0WRI32O 

D0  11     L=l.J2  P0WR133O 

IF(R(1.L))  80.'*4,a0  P0WR134C 

eO  M=J-L+1  P0WR135C 

IF(Q{ I ,M ) )82.44.82  P0WR136O 

62  SUMe=R(  1,L)«C(  l.M)*SUMB  P0WR137O 
44  C0NTINUE  P0WRI38O 

C  P0WRI39O 

PDIV  =  (P(  1  . J)-SUMB)/Q(  1.1)  P0WR14OO 

G0  T0  e  P0WR141O 

C  P0WR142O 

5  12=1-1  P0V»R143O 

00  55  K=1.I2  P0WR144G 

IF(R(K.l))    63,55,83  P0WR145O 

63  K2=I-K-H  P0WR146O 

IF(0(K2,1))  81.55.81  P0WR147O 

ei  SUMA=R(K . 1  )»Q( K2.  1  )  +  SUMA  P0WR148O 

55  C0NTINUE  P0WR14gO 

c  pawRisoc 

P0IV=(P(I.1)-SUMA)/G(1.1)  P0WR151O 

G0  T0  e  P0WR152O 

C  P0WR153O 

£   12=1-1  P0WR154C 

J2=J-1  P0*R155C 

00  66  K=1,I2  P0WR156O 

C0  66  L= 1, J  P0WR157O 

IF(R(K,L))    84,66,84  P0WR158O 

64  L2=J+1-L  P0WR159C 
K2=I+1-K  P0WR16OO 

IF(Q(K2,L2 ) )e5,ee.85  P0WR161O 

eti     SUMA  =  R(K,L  )»0(  K2.L2)  +  SUMA  P0WRI62O 

efc  C0NTINUe  P0WR163O 


P0WR 164C 
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D0  77   M=l , J2 

IF(H( 1 .M) )    66,77.86 

IF(0( 1.M2 ) )  87.77.87 

suMe  =  H{It^')•c(  i.MZJ  +  suMB 

CUNT INLE 

PDIV=(P( I . J)-SLMA-SLMB)/C( I. I ) 

k( I.J)=PCIV 
RETLRN 
ENC 

LISTC 
SUBR(5UTINC  P0tN(PQ.Xl,Yl,K,fiH0,III.SX.SY^ 

IFINE=0 

K-H=DEGREE     PeLY.RHB^INTERPaLATieN    C0NSTANT 
CIMENSIBN     SX(25.?5).£V(25.2S).PG(2S.?5) 
M  =  C 

IF (NARG  )4,  1.1 
WPG=PEVAL(PG.X1.Y1 .K) 

THIS  EVALUATES  C  IN  PQ(X.Y)=C  KHERE  X, 
This  EVALCATI0N  IS  DBNE  0NLY  eKCE 
X  =  X  1 


VRE  THE  INITIAL  VALUES 


VDELX=PeVAL(SX.XI.Yl.K) 

V0ELY=PEVAL(SY.X1.YI.K) 

S<?  =  SQRTF  (  VCELX«»2  +  VDELY«»2) 

X1=XI-VCELY/SZ»RH0 

Y1=YI+VCELX/SZ»RH0 

VP0=PEVAL(PQ,X I.YI .K ) 

THE  INITIAL  GLESS  IS  ALONG  THE  TANGENT  A  DISTANCE  RH0 

IF( ARSFI VCELV)-XLIK)5.5.7 

INTeRP0LAT I0N  AL0NG  THE  N0RMAL  T0  THE  T ANGEN T . T ANGENT  IS 

VOELX=PEVAL(SX.Xl.Yl.K) 

T=( »PQ-VPG  )/VCELX 

Xl=Xl+T 

VDELX=PEVAL(SX.X1.YI.K) 

VPO=PEVALCPQ.X I .YI .K) 

T=:(  »PQ-VPQ  )/VDELX 

IF(ARSF(T)-XLIM)50.50.6 

IF(M-LL )55.45.45 

IF(ABSF(VCELX)-XLIM>e.e.lC 

INTERP  AL0NG  THE  N0RMAL  T0  THE  T ANGENT . T ANGEN T  IS  H0RIZe^ 

VOfcLY=PEVALtSY.Xl.Yl.K) 

T=t»PO-VPQ)/VCELY 

Y1=YI+I 

VPQ=PEVAL(PO.X l.Yl .K ) 

VDELY=PEVAL( SY.Xl , Yl .K) 

T=( »PQ-VPQ )/VCELY 

IF(ABSF(T)-XLIM)50.50.9 

M  =  M+1 

IF(»/-LL  jee.OE  .  45 

INTERP0LAT I0N  IS  AL0NG  THE  N0RVAL  T0  THE  TANGENT 

T=VCELY/VCELX 

VOELX=PEVAL(£X,Xl.YI.K) 


P0WR165O 
P0WR166O 
P0*R167O 
P0WRI68O 
P0WR 1690 
P0wRirOO 
P0WRI 7 10 
P0WH  1720 
P0WR173O 
P0WR 1 740 
P0WR175O 
P0WR 1760 
P0WR 1770 
P0WR  1780 
P0WR1 790 
P0MR18OO 
P0MRieiO 
P0».R182O 
P0WR183O 
P0VIIR184C 
P0ViR  1850 
P0*R186O 
P0WR187O 
P0WR 188C 
P0WR 1890 
P0WR 1900 
P0OR191O 
P0WR 1920 
P0WR193C 
P0WR194O 
P0XR195O 

ERTICAL  P0V«R196O 
P0WR197O 
P0WR198O 
Pa«RI<;90 
P0*R2OOO 
P0KR2OIO 
P0WR2O2O 
P0WR2O3O 
P0»(R2O4O 
P0V«R?O5O 
P0«R2O6O 

AL  P0WR2O7O 
P0WR2O8O 
P0WR2O9O 
P0WR2IOO 
P0WR21 10 
P0WR2I2O 
P0WR213O 
P0WR2 1 40 
P0WR215O 
P0WR2 160 
P0>«Ri?17O 
P0WR218O 
P0WR219O 
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VDELY=PEVAL(SY.X1,YI,K) 

TT=VDELX+T»VDELY 

TTT=(\i»PQ-VPQ)/TT 

X  1  =  X ItTTT 

Y1=Y1+T»TTT 

VDeLX=PEVAL(SX,Xl,Yl.K) 

VDELY=PevAL(SY.XI.Yl.K) 

TT=VCELX+T«VDELY 

VPQ=PEVAL(PQ,X1,Y1 ,K) 

TTT=(*PO-VPQ )/TT 

IF(AeSF(TTI)-XLIf)£0.50.12 

IF(M-LL)  I  1  1  .45.45 

IF(  IF INE  )47.4e .47 

I  1  1=999 

THIS  INDICATES  A  FAILURE. eeTH  WITH 

BY  TESTING  III  THE   I N TERP BL A T I 0N  C 

Qli     T0     52 

IFINE=1 


HH2= . 1 •RFK 
G0  T0  44 
CUNT INUE 

IF(  IF  INE  )51  .52.51 
RH0=  1O.«RH0 

INTERPaUAT I0N  FAILED. TRY  A  SMALLE 
RETURN 
END 
LIST8 
F0R  J.  LEAVITT  BY  F)  RAGLS 


SUeR0LTINE  PEXP(P,G.N) 

T0  FIND  TFE  C0EFFICENTS  Q{1).C(2), 

DIMENSION  P( I ).  0(1) 

(J(  I  )  =  exPF  (P(  I  )  ) 
0(2)  =  P(2)  •  Q(l) 


KE  =  I 
U(KE) 


K   r    2  .    NtF 

+   I 

P(2)  *  C(K)  /  FK 
1 


Ttyp  =  o.c 


Kl=  K-I 
FI  =  I  ♦ 
TEVP  =  FI 


P0WH22OO 
P0WR221O 
P0WR222O 
P0WH223O 
P0WR224C 
P0WR225O 
P0WR226O 
P0WR227O 
P0WR228O 
P0WR229O 
P0WR23OO 
P0WR231O 
P0WR232O 
P0IKR233O 
P0WR234O 

REGLLAB  AND  SMALLER  BH(?  P0WR235O 

IN  BE  HALTED  IN  THE  MAIN  PH0CR AMP0 WH2360 
P0WR237O 
P0«irR23eC 
P0WR239O 
P0WR24OO 
P0WR241O 
P0*R242O 
P0MR243O 
P0WR244O 
P0WR245O 
P0*H246O 

RH0  P0WR247O 

P0WR24aO 
P0WR249O 
P0WR25OO 
P0WR251C 
P0wn252O 
P0\»H253O 
PawR254C 
P0WR255O 
P0WR256O 
P0WR257O 
P0WR258C 
P0WR259O 
P0WR26OO 
P0WR261O 
P0WR262O 
P0*R263O 
P0I«|R264O 
P0WR265O 
P0WR266O 
P0WR267O 
P0WR268O 
P0WR269O 
P0*R27OO 
P0WR271O 
P0WR272O 
P0WR273O 
P0WR274O 


JLNE  24.1963. 


)  F0R   Q=EXF(P). 
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P0WR275O 
Q(KE)  =  QCKE)  ♦  1.0  /  FK  •  TEVP  P0IKR276O 

C0NTINUE  P0WH277O 

RETURN  P0WR278O 

END  P0WR279O 

LISTS  pawR2eoo 

F0R  J.  LEAVITT  BY  F)  RAGLSA .    JLKE  24.1963.  P0WR281O 

SueR0UTINE  PL0G(P,Q.N)  P0WR2e2O 

T0  FIND  THE  CaEFFICIENTS  C (  1  )  , Q ( 2  )  , . . . 0 ( N    )  F0R   O  =  L0G(P)  P0WR283O 

OIf'ENSI0N  P(l>.  0(1)  P0wR2e4C 

Qtl)  =   L0GF(  P(l)   )  PawR2e50 

0(2)  =  P(2)  /  P(l)  P0WR286O 

NUF  =  N  -   1  P0WR2e7O 

00  2   K  =  2.  NUF  P0WR2e8O 

Kfc  =  K  ♦  I  P0wR2e9O 

P0WR29OO 
P0WR291O 
P0i«(R292O 
P0*R293O 
P0«R294O 
P0WR295O 
P0WR296O 
P0*«H297O 
P0WR298O 
P0MR299O 
P0li(R3OOO 
P0WR3O1O 
I.  P0WR3O2O 

P0WR3O3O 
P0WR3O4O 
P0WR3OSO 
)  F0R   0=P  ••XL.         P0WR3O6O 
P0lifR3O7O 
P0WR3O8C 
P0*H3O9O 
P0WR31OO 
P0WH31 10 
C(l)  •  P(3)   )  /  P(l)    P0WR312O 
P0MR313O 
NUF=  N- 1  P0WR314O 

00  2   K=    3.    NUF  P0WR315O 

FK  =  K  P0WH316O 

KE  =  K  ♦   1  P0WR317O 

Q(KE)=  ((XL-FK  ♦   1.0)  /  FK)   •  0(K)  •  P(2)  ♦  XL  •  0(1)  •  F(KE)      P0WR3ieO 

P0HR319O 
KL  =  K  -   1  P0WR32OO 

TEMP  =  0.0  P0WH321O 

P0WR322O 
00    1    1  =  2,    KL  Pav<R3230 

FI  =   I  P0WR324O 

Kl  =  KE  -  I  P0*R325O 

TEVP  =  (  FI  •  (   XL  +  1.0  )   /  FK  -  1.0  )  •  C(K1)   •  P(I*1)   ♦  TEWP   P0WR326O 

P0WR327O 
0(KE)  =  (  0(KE)  ♦  TEMP  )  /  P(l)  P0aH32eO 

C0NTINUE  P0WR329O 


KL  =   K  -  1 

FK  =  K 

TEMP  =  0.0 

00   1    1=1.    KL 

FKl  =  K  -   I 

KI  =  K  -   I 

1 

TEMP  =    FKI  •  Q(  KI  +  1   )   •  P  (I+l)  +  TEMI 

Q(KE)  =  (  P(Ke)  -   (1.0/FK)  •  TEMP  )  /  P( 

2 

C0NTINUE 

RETURN 

END 

• 

LISTS 

CPPViR 
C 

F0R  J.  LEAVITT  BY  F)  RAGUSA.    JUNE  24,1' 

SUeR0UTINE  PP*R(P .Q.XL.N) 

C 

T0  FIND  THE  C0EFFICIENTS  C (  1  )  . 0 ( 2 ) . . .  .  0 ( 1 

c 

DIMENSI0N  P(  1  )  ,  0(1) 

Q( 1 )=P( 1 )«»XL 

Q(2)=XL  •  0(1)  •  P(2)  /  P(l) 

Q(3)=(((   XL-1.0)  /2.0)  •  C(2)^  P{2)      *     XL 
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RtTURN 

END 

LISTO 

FZR  J.  LEAVITT  BY  F)  RAGtSA.    JLNE  24.1963. 
SUEReuTINE  PTRIG(  P.  Q.  R.  N) 

T0  FIND  Tl-E  C0EFFICIENTS  C(I).  C(2) C(N    )  FeR  0=  SIN(P) 

AND  R(l),  R(2) R(N    )    F0R  R  =  CBS  (P) 


DIMENS I 0N  P(  1  )  , 


Qt  I  ) 


□  (  1  )=SINF   (  P( 1  )   ) 
W{  I  )  =  C0SF  (  P{  1  )   ) 
Q(2)=  R(  1  )  •  P(2) 
R(2  )  =  -Q(  1  )  •  P{2) 


Q(KE )  =  H( 1 )  •  P(KE) 
R(KE)  =-Q(  1  )  •  H(KE) 


PEKPl  =  0.0 
TEMP2  =  C.C 


TEMPI  =  FK I   •  R{ 
TEVP2  =   FKI   •  C( 


1  ) 


P(K2*1)  ♦  TEKPl 
P(K2»1)  ♦  TeNP2 


Q(Ke  )  =  Q(KE  )  ♦  1 .0  /  FK 
R(KE)  =  R(Ke )  -  1.0  /  FK 

CUNTINUE 

RETURN 
END 


TEMPI 
TEMPa 


P0WR33OO 
P0WR331C 
P0WH332O 
P0WR333O 
P0MR334C 
P0WR335O 
P0»rR336O 
P0WR337O 
P0v»R33aO 
P0MR339C 
P01IKR34OO 
P0WR341O 
P0WR342O 
P0WR343O 
P0WR344O 
P0WR345O 
P0WR346O 
P0WR347O 
P0WR348O 
P0WR349O 
P0WR35OO 
P0WR351O 
P0WR352O 
P0WR3S3O 
P0WR354C 
P0WR355O 
P0WH356O 
P0WR357O 
P0WR358O 
P0WR3S9O 
P0WR36OO 
P0WR361O 
P0WR362O 
P0WR363O 
P0WR364O 
P0WR365O 
P0WR366O 
P0WR367O 
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System  Library  Functions 

The  subroutines  In  this  group  logically  fall  Into 
two  classes  -  those  which  perform  an  arithmetic  function 
and  those  which  supply  a  utility  function.   In  either  case 
these  subroutines  are  a  part  of  any  FORTRAN  II  system  and 
the  programmer  does  not  need  to  be  concerned  with  supply- 
ing decks  (either  binary  or  symbolic)  for  these  routines. 
These  subroutines  are  all  "closed"  subroutines,  i.e.  only 
one  copy  of  the  subroutine  will  appear  in  the  object 
program  regardless  of  the  number  of  times  the  subroutine 
is  referenced . 

a)  Arithmetic  Library  Functions 

The  subroutines  in  this  group  that  are  used  by  the 
routines  listed  previously  in  this  report  are  given  below. 

Name  Function 

ATAN  Arctangent 

C0S  Trigonometric  Cosine 

DC0S  Double  Precision  Cosine 

DEXP  Double  Precision  Exponential 

DSIN  Double  Precision  Sine 

EXP  Exponential 

IC0S  Complex  Cosine 

lEXP  Complex  Exponential 

IL0G  Complex  Natural  Logarithm 

IS IN  Complex  Sine 

ISQRT  Complex  Square  Root 

L0G  Natural  Logarithm. 

SIN  Trigonometric  Sine 

SQRT  Square  Root 

It  should  be  noted  that  the  FORTRAN  II  system  for  the  709^ 
computer  supplies  additional  subroutines  to  perform  certain 
arithmetic  operations,  e.g.  exponentiation  and  double 
precision  arithmetic.   The  number  and  use  of  these  subroutines 
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is  a  function  of  the  FORTRAN  compiler  used  and  so 
nothing  further  will  be  said  about  them. 

b)  Utility  Library  Functions 

During  the  execution  of  statements  such  as 

WRITE  0UTPUT  TAPE 
READ  INPUT  TAPE 
WRITE  TAPE 

various  subroutines  are  used  to  accomplish  the  desired 
function.   The  number  and  use  of  these  subroutines  again 
depends  upon  the  particular  system  that  Is  used  and  hence 
will  not  be  discussed  any  further. 

Two  additional  subroutines  used  by  the  routines 
listed  earlier  in  this  report  fall  into  this  general 
category.   They  are  the  XL0C  function  and  the  overflow 
routine  FPT.   The  XL0C  function  returns  as  its  value  the 
address  of  its  argument.   The  FPT  routine  handles  floating- 
point overflow  and  underflow  conditions  during  the  execution 
of  a  program.   Both  of  these  routines  are  a  part  of  the 
basic  FORTRAN  II  system.   However,  New  York  University  has 
written  new  versions  of  these  routines  and  the  listings 
of  these  versions  and  the  write-up  for  FPT  are  included  at 
the  end  of  this  section. 

System  Built-in  Functions 

These  functions  are  a  part  of  any  FORTRAN  II  system 
and  are  "open"  subroutines,  i.e.  they  appear  in  the  object 
program  each  time  they  are  referenced.   The  definitions  of 
the  functions  that  are  used  by  the  routines  in  this  report 
are  given  below. 
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Name 

Definition 

ABS 

|Arg| 

XABS 

PL0AT 

Float  a  fixed  numl 

MAXl 

Max(Arg-j_  ,  Argg  , 

XMAXO 

ArgJ 

MINO 

Min(Arg-|^,  Arg^,  • 

MINI 

Arg^) 

XMINO 

SIGN 

Sign  of  Argg 

XSIGN 

times  |Arg.| 

XINT 

Sign  of  Arg  times 

XFIX 

largest  integer  < 

I  Arg  I 

XM0D     Arg^-[Arg^/Arg2] 

where  [X]=integral  part  of  X 


Mode  of 
Argument  Function 

Floating  Floating 
Fixed    Fixed 

Fixed    Floating 

Floating  Floating 
Fixed    Fixed 

Fixed  Floating 
Floating  Floating 
Fixed    Fixed 

Floating  Floating 
Fixed    Fixed 

Floating  Fixed 
Floating  Fixed 


Fixed 


Fixed 
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FAP 

INUXL0C  NU 

VERSI0N  01 

PCC 

LHL 

NUXL0C.X 

ENTW 

lY     XL0C 

XLKC 

SXA 

EXIT. 

CLA 

C0N 

STa 

L2 

TEST 

CAL 

-  1  .0 

LPS 

15 

SUB 

TCSTl 

TNZ 

L3 

LLS 

15 

STA 

LI 

TX  I 

TEST. 

1.3 

ACC 

TESTl 

LHS 

sue 

TESTS 

Tze 

F0LND 

TXI 

TEST. 

F0CNO 

LLS 

le 

0RS 

L2 

LI 

LXC 

••.A 

L2 

PXD 

«  •  ,  •• 

POC 

0  .A 

TWA 

1  .A 

TESTl  0CT 

OCOCOA63400A 

TEST2  0CT 

CC0000050000 

ADDRESS  0F  ARGLKENT  LTILITV  R0UTINE  -  FAP  CeCEC 


NUXL0COO 
GBLCSTEIN   6/62  NUXL0COI 

NUXL0CO2 

NUXL0CO3 

SAVE  XA  NUXLBC04 

SEARCH  F0R  (SXC««.A)  AND  CLA       NUXL0CO5 

NUXL0CO6 

NUXL0CO7 

NUXL0COe 

NUXL0COq 

L(SXC     X«.A)     SCALED    BY     15  NUXL0C1O 

sex     SXD  NUXL0C11 

YES     SXD  NUXL0CI2 

SAVE  ADDRESS  WHERE  ST0REC  NUXL0C13 

NUXL0C1A 
SEARCH  FBR  CLA  NUXL0C15 

TAG  ♦  ADDRESS  IN  MQ  NUXL0CI6 

L(CLA)  SCALED  BY  18  NUXL0C17 

NUXL0C 18 
NKT  CLA.  C0NTINUE  SEARCH  NUXL0C19 

NUXL0C2O 

F0RM  ADD.  AND  TAG  0F  PXD  IN  L2     NUXL0C21 

IF  XA  USED,  CeNTAINS  ADO.  NUXL0C22 

C0NTENTS  0F  INDEX  USED  Te  OECR.   NUXL0C23 

F0RM  EFFECTIVE  ADDRESS  NUXL0C24 

...  NUXL0C25 

...  NUXL0C2e 

...  NUXL0C27 

ST0RE  ANS.   IN  OECR  NUXL0C2e 

NUXL0C29 
SETURN  NUXL0C3O 

NUXL0C3 1 
NUXL0C32 
NUXL0C33 
NUXL0C34 
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Identification:      FPT  -  Floating  Point  Trap  Subroutine 

7090  FAF  Coded 

Purpose:   This  subroutine  provides  alternate  methods 

for  dealing  with  a  floating  point  overflow  or 
underflow . 

Method :    Upon  sensing  a  floating  point  overflow  or 

underflow  the  Computer  will  automatically  place 
the  address  +  1  of  the  instruction  that  caused 
the  condition  into  the  address  part  of  location 
00000.   In  addition,  an  identifying  octal  code, 
indicating  the  type  of  spill  and  the  register(s) 
Involved,  is  placed  into  the  decrement  part  of 
location  00000.   The  Computer  then  executes  the 
instruction  at  location  OOOlOo  and  proceeds  from 
there . 

The  identifying  octal  code  as  it  appears  in  the 
decrement  part  of  location  00000  is  set  up  as 
follows : 
If  the  Operation  The  Reglster(s)  Involved   Octal 


was 

a             Ace 

MQ 

Code 

FAD, 

FSB, 

,  FMP,FRN 

underflow 

01 

underflow 

underflow 

03 

overflow 

06 

overflow 

overflow 

07 

FDH, 

FDP 

underflow 

underflow 

11 
12 

underflow 

underflow 
overflow 

15 

15 

This  subroutine  interprets  the  contents  of 
location  00000  after  a  floating  point  underflow 
or  overflow  has  caused  entry  to  it  and  acts  upon 
the  register (s)  involved  as  follows: 
If  an  underflow  occurred,  the  proper  register  (AC 
and/or  MQ)  is  set  to  zero,  and  control  returns  to 
the  next  Instruction  after  that  which  caused  the 
underflow . 
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2.  If  an  overflow  occurred,  the  course  of  action 
--  whether  to  terminate  the  job,  stop,  or  set 
the  registers  involved  to  377  777  777  777  and 
continue  Is  determined  by  the  alternate  entries 
to  the  routine. 
Usage:     There  are  three  entries:   (FPT),  FPTEST,  FP0LD. 
I.   Entry:   (FPT) 
A.  FORTRAN :   Each  main  FORTRAN  program  complied  will 
automatically  have  Inserted  as  Its  first  three 
executable  Instructions  the  necessary  entry  to 
(FPT)  as  follows: 
CLA    (FPT) 
ST0    8 
STZ   4) -205       Location  77^62g 

The  programmer  therefore  need  not  do  anything 
about  the  entry  to  this  routine. 
When  control  Is  transferred  to  (FPT)  (via  the 
TTR  at  location  10 )o  the  following  takes  place: 

1)  If  an  underflow  occurred,  the  proper  register 
(AC  and/or  MQ)  Is  set  to  zero,  and  control 
returns  to  the  next  Instruction  after  that 
which  caused  the  underflow. 

2)  If  an  overflow  occurred,  the  sequence  of  events 
that  follow  will  be  determined  by  whether  the 
program  causing  the  overflow  is  being  processed 
In  the  FORTRAN  Monitor  System  or  out  of  it. 

a)  In  the  FORTRAN  Monitor  System: 

The  Job  will  be  terminated  and  the  following 
information  will  be  printed  on-line  and 
written  off-line: 

1.  "FLOATING  POINT  OVERFLOW  IN  AC  OR  MQ" 

2.  Address  part  of  location  00000  in  octal 
5.  Bits  4-17  of  location  00000  in  octal 

4.  Q  and  P  bits  of  the  AC 
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5-  Contents  of  AC  and  MQ 

6.  "EXECUTION  TERMINATED  BY  EXEM" 

b)  Out  of  the  FORTRAN  Monitor  System: 

An  HPR  2,h   will  occur.   If  START  key  Is  pressed, 
the  proper  register  (AC  and/or  MQ)  where 
overflow  occurred  will  be  set  to  377  777  777  777. 
Locations  00000  and  77^62  contain  the  spill 
code  and  address  +  1  of  Instruction  causing 
overflow . 
Note  that  this  routine  differs  from  the  original 
IBM  version  of  (FPT)  which  was  used  to  arrive  at 
the  descriptions  for  the  statements  "IF  ACCUMULATOR 
OVERFLOW"  and  "IF  QUOTIENT  OVERFLOW"  described  In 
FORTRAN  Reference  Manual.   These  FORTRAN  statements 
have  no  significance  here. 
B.  FAP:   Relocatable  FAP  m.aln  programs  should  be 
written  to  contain  the  three  Instructions: 
CLA    $  (FPT) 
ST0    8 
STZ    32562 
The  third  Instruction  Is  optional  and  may  be 
omitted . 
II.    Entry:   FPTEST 

If  this  entry  is  used  by  the  statement: 

CALL    FPTEST(A) 
the  overflow  section  of  this  subroutine  is 
modified  so  that  when  an  overflow  Is  sensed, 
the  contents  of  location  zero  are  stored  in 
the  variable  A  and  in  location  77^62,  the 
proper  register  (AC  and/or  MQ)  is  set  to 
377  777  777  777  and  control  returns  to  the 
next  instruction  after  that  which  caused  the 
overflow.   If  the  programmer  sets  A  to  zero 
before  the  CALL,  he  may  then  test  it  after 
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floating  point  operations  to  determine  whether 
an  overflow  has  occurred  and  take  his  own  course 
of  action.   Also  In  FORTRAN,  the  statements, 
"IF  ACCUMULATOR  OVERFLOW"  and  "IF  QUOTIENT 
OVERFLOW"  may  be  used.   (The  contents  of 
location  OOOlOg  are  saved  and  replaced  with  a  TTR 
to  an  alternate  entry  to  (FPT).) 
III.   Entry:   FP0LD 

If  this  entry  Is  used  by  the  statement 

CALL  FP0LD 
location  OOOlOo  Is  replaced  with  the  Instruction 
that  was  there  before  the  FPTEST  entry  or  If 
there  was  no  previous  entry  by  a  TTR  to  (PPT) • 

Storage;   56-|q  =  70©  locations  plus  absolute  locations 
77^628 -and  77^638- 
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